怎样使用Excel编程(怎样利用Excel进行VB编程)

内容导航：

怎样使用Excel编程
怎样利用Excel进行VB编程

一、怎样使用Excel编程

我用VB连过。
下面是我当时写的一个函数，从SQLServer2000中导出查询结果的。调用就可以了。记得在工程－－》引用中添加Excel的引用 Microsoft Excel 11.0 Object Library
（可能是不同的版本）
另外把连接字符串改一下。
如果你要用到其他方面，可以加我285512334
Public Function ExporToExcel(strOpen As String, str_name As String)
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'& 功能：导出数据到EXCEL
'& 用法：ExporToExcel(sql查询字符串，导出表的名称)
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Dim adoRs As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer

Dim xlapp As New Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable

Dim strcn_out As String

strcn_out = "Provider=SQLOLEDB.1;PeRs_tongjiist Security Info=False;User ID=sa;pwd=sa;Initial Catalog=st_info;Data Source=(local)"
With adoRs
If .State = 1 Then
.Close
End If
.ActiveConnection = strcn_out
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Source = strOpen
.Open
End With
With adoRs
If .RecordCount < 1 Then
MsgboxName = MsgBox("没有记录！", vbOKOnly, "信息提示")
Exit Function
End If
Irowcount = .RecordCount '记录总数
Icolcount = .Fields.Count '字段总数
End With

Set xlapp = CreateObject("Excel.Application")
Set xlbook = Nothing
Set xlsheet = Nothing
xlapp.Caption = str_name

Set xlbook = xlapp.Workbooks().Add
Set xlsheet = xlbook.Worksheets("sheet1")
xlapp.Visible = True
Set xlQuery = xlsheet.QueryTables.Add(adoRs, xlsheet.Range("a1")) '添加查询语句，导入EXCEL数据
With xlQuery
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
End With

xlQuery.FieldNames = True '显示字段名
xlQuery.Refresh

With xlsheet
With .Range(.Cells(1, 1), .Cells(1, Icolcount))

.Font.Name = "宋体" '设标题为黑体字
.Font.Bold = True '标题字体加粗
'.Interior.Color = &HC0FFC0 '设定第一行颜色
.ColumnWidth = 18
End With

With .Range(.Cells(1, 2), .Cells(1, 2)) '设定列宽度
.ColumnWidth = 10
End With
With .Range(.Cells(1, 3), .Cells(1, 3))
.ColumnWidth = 20
End With
With .Range(.Cells(1, 5), .Cells(1, 5))
.ColumnWidth = 10
End With
With .Range(.Cells(1, 6), .Cells(1, 6))
.ColumnWidth = 6
End With

With .Range(.Cells(2, 1), .Cells(Irowcount + 1, 1))
.Font.Name = "楷体"
'.Interior.Color = &H80FFFF '第一列颜色
End With
End With
On Error GoTo yes
'第一种方法：调用保存函数xlApp.SaveWorkspace
'第二种方法，后台saveas，指定目录
Position = App.Path & "统计数据存档" & str_name & ".xls"
xlbook.SaveAs Position
'第三种方法，用户关闭时，自己保存
xlapp.Application.Visible = True
yes:
Set xlapp = Nothing '交还控制给Excel
Set xlbook = Nothing
Set xlsheet = Nothing
End Function

二、怎样利用Excel进行VB编程

Const C1 = 10 '连续数调整值
Const C2 = 15 '非连续数调整值
Const S = 10 '设定连续范围
Sub process()
Dim a, i!, j!, d!, n
Range("A1").Sort key1:=Range("A1"), order1:=xlAscending
a = WorksheetFunction.Transpose(Range("A1:A" & [A65536].End(xlUp).Row))
For i = 1 To UBound(a)
d = a(i) + S
For j = i To UBound(a)
If j + 1 > UBound(a) Then Exit For
If a(j + 1) > d Then Exit For
Next
If i = j Then '非连续数
a(i) = a(i) - C2
Else '连续数
n = a(i) - C1
For k = i To j
a(k) = n
Next
i = j
End If
Next
Range("B1").Resize(UBound(a)) = WorksheetFunction.Transpose(a)
End Sub