请问:
你的 Private Sub exporttoexcel(rsdata As ADODBRecordset, filenamesaveas As String)的声明是在Module里吗?如果是,将Private 改为Public,然后试试
注:Form中过程或函数等,无法对Module中以Private声明的过程或函数等调用
希望以上对你有所帮助。
可以两种方式:
1、用VB *** 作EXCEL类,然后将SQLSERVER的数据查询到dataset中,循环dataset中的数据到EXCEL;
2、将EXCEL当作数据源,用MicrosoftJetOLEDB40来连接,然后直接将SQLSERVER的数据写入EXCEL的SHEET1表中。
用下面这段代码,根据自己实际修改一下就好
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As ExcelApplication
Dim xlBook As ExcelWorkbook
Dim xlSheet As ExcelWorksheet
Set xlApp = CreateObject("ExcelApplication")
xlAppVisible = True
Set xlBook = xlAppWorkbooksAdd
Set xlSheet = xlBookWorksheets(1)
If Adodc1RecordsetRecordCount > 0 Then
xlAppVisible = True
xlSheetRange(xlSheetCells(1, 1), xlSheetCells(1, 9))Merge
xlSheetRange(xlSheetCells(1, 1), xlSheetCells(1, 9)) = "未发料统计表"
xlSheetRange(xlSheetCells(1, 1), xlSheetCells(1, 9))HorizontalAlignment = xlCenter
xlSheetRange(xlSheetCells(1, 1), xlSheetCells(1, 9))VerticalAlignment = xlCenter
'xlSheetCells(1, 9) = "未发料统计表"
For i = 0 To TDBGrid1ColumnsCount - 1
xlSheetCells(2, i + 1) = TDBGrid1Columns(i)Caption
Next i
Adodc1RecordsetMoveFirst
Do Until Adodc1RecordsetEOF
i = Adodc1RecordsetAbsolutePosition
For j = 0 To TDBGrid1ColumnsCount - 1
xlSheetCells(i + 2, j + 1) = TDBGrid1Columns(j)
Next j
Adodc1RecordsetMoveNext
Loop
xlSheetRange(xlSheetCells(1, 1), xlSheetCells(i + 2, j))BordersLineStyle = xlContinuous
End If
End Sub
Private Sub Command1_Click()
Dim xlapp As Variant
Dim xlBook As Variant
Dim xlSheet As Variant
Dim sum As Long
Set xlapp = CreateObject("excelapplication")
Set xlBook = xlappWorkbooksOpen(AppPath & "\data\报表xlt") '打开EXCEL模板
'Set xlBook = xlappWorkbooksAdd
Set xlSheet = xlBookworksheets(1)
xlappVisible = True
Adodc1ConnectionString = cnConnectionString
Adodc1RecordSource = "select from [Sheet1] where 试验号='" & shiyanH & "'"
Adodc1Refresh
If Adodc1RecordsetRecordCount > 0 Then
Adodc1RecordsetMoveFirst
xlSheetCells(sum + 1, 2) = shiyanH
For sum = 0 To Adodc1RecordsetRecordCount - 1
xlSheetCells(sum + 3, 1) = Adodc1Recordset(1)
For j = 2 To 21
If Adodc1Recordset(j) <> "" Then
If Adodc1Recordset(j) = "" Then
xlSheetCells(sum + 3, j) = (Adodc1Recordset(j))
Else
xlSheetCells(sum + 3, j) = Val(Adodc1Recordset(j))
End If
End If
Next
Adodc1RecordsetMoveNext
Next sum
End If
End Sub
Sub Main()
cnConnectionString = "Provider=MicrosoftJetOLEDB40;Data Source=" & AppPath & "\data\tsdbmdb;Persist Security Info=False"
frmStartShow
End Sub
以上是读取Access数据表,导入到Excel的代码。
'Visual Basic调用Excel有点难,但是Excel有一种CSV逗号分隔格式,可以借助FileSystemObject来创建。
'先像你那张一样画好窗体,四个文本框分别设为txtName、txtChinese、txtMaths、txtZhengZhi,按钮设为CmdOut。
'代码如下:
Public strPathName
Private Sub Form_Load()
InputPath:
strPathName = InputBox("请输入表格保存位置","请输入")
If Right(strPathName,3) <> "csv" Then strPathname = strPathName & "csv"
Set fso = CreateObject("ScriptingFileSystemObject")
If fsoFileExists(strPathName) Then
A = MsgBox("文件已存在,是否覆盖",vbYesNo,"文件已存在")
If A = vbYes Then
Kill(strPathName)
Else
GoTo InputPath
End If
End If
Set txtfile = fsoCreateTextFile(strPathName,True)
End Sub
Private Sub Command1_Click()
Set fso = CreateObject("ScriptingFileSystemObject")
IntFreeFile = FreeFile
Open strPathName For Input As IntFreeFile
strContent = StrConv(InputB(LOF(IntFreeFile), IntFreeFile), vbUnicode)
Close #IntFreeFile
If strContent = "" Then
Kill(strPathName)
Set txtfile = fsoCreateTextFile(strPathName,True)
txtfileWrite("姓名,语文,数学,政治" & vbCrlf & txtNametext & "," & txtChinesetext & "," & txtMathstext & "," & txtZhengZhitext)
txtfileClose
Else
Kill(strPathName)
Set txtfile = fsoCreateTextFile(strPathName,True)
txtfileWrite(strContent & vbCrlf & txtNametext & "," & txtChinesetext & "," & txtMathstext & "," & txtZhengZhitext)
txtfileClose
End If
End Sub
'经测试代码可以使用,没有Bug
'生成的Excel:
以上就是关于关于VB6.0导出SQL数据库中数据到EXCEL代码问题全部的内容,包括:关于VB6.0导出SQL数据库中数据到EXCEL代码问题、vb导出sqlserver数据库中表的数据到excel中,在程序中点击Command按钮,就导出了 !、VB中把SQL数据库的数据输出到Excel等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)