-
-
-
czj2008szdf | 当前状态：在线
总积分：722 2024年可用积分：0
注册时间： 2008-07-04
最后登录时间： 2019-07-13
-
-
ifix EXCEL报表 代码
czj2008szdf 发表于 2009/4/22 9:13:51 1322 查看 0 回复 [上一主题] [下一主题]
手机阅读
VBA中引用
Microsoft Excel 11.0 Object Library和
Microsoft ADO 6.0
Library。在画面中添加个按钮。复制以下代码：
Option Explicit
Dim rsADO As ADODB.Recordset
Dim cnADO As ADODB.Connection
Private Sub Command1_Click()
Dim StrDir As String
StrDir = "E:\"
Dim i As Long
Dim Sql As String
Sql = "SELECT * FROM THISNODE"
Set cnADO = New ADODB.Connection
Set rsADO = New ADODB.Recordset
cnADO.ConnectionString = "Provider = Microsoft OLE DB Provider for ODBC
Drivers;DSN=FIX Dynamics Real Time Data;UID=;PWD="
cnADO.Open
rsADO.CursorLocation = adUseClient
rsADO.Open Sql, cnADO, adOpenDynamic, adLockUnspecified, -1
If rsADO.RecordCount <= 0 Then
MsgBox "无数据！", vbOKOnly + vbInformation, "信息..."
Set cnADO = Nothing
Set rsADO = Nothing
Exit Sub
End If
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Set xlApp = New Excel.Application
xlApp.DisplayAlerts = False
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open(StrDir & "\报表.xls")
Set xlSheet = xlBook.Worksheets(1)
For i = 1 To rsADO.RecordCount
xlSheet.Cells(i, 1) = rsADO.Fields(1).Value & ""
xlSheet.Cells(i, 2) = rsADO.Fields(2).Value & ""
xlSheet.Cells(i, 3) = rsADO.Fields(3).Value & ""
xlSheet.Cells(i, 4) = rsADO.Fields(4).Value & ""
Next i
xlApp.Visible = True
xlApp.DisplayAlerts = False
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Set cnADO = Nothing
Set rsADO = Nothing
End Sub