vb程程序，导出到EXCEL的问题
大家好，我想把datagrid中显示的记录的记录导出到excel
我在module模块中加入以下代码
Public ExcelApp As Excel.Application
Public ExcelBook As Excel.Workbook
Public ExcelSheet As Excel.Worksheet
Public IsOpen As Integer
'取值
Public Function GetExcelKey(r As Long, c As Long) As String
On Error GoTo SysErr
GetExcelKey = ExcelSheet.Cells(r, c)
Exit Function
SysErr:
MsgBox Error, vbInformation + vbOKOnly, ""
End Function
'设置背景颜色
Public Sub SetExcelColor(r As Long, c As Long, Color As Long)
On Error GoTo SysErr
ExcelSheet.Cells(r, c).Interior.ColorIndex = Color
Exit Sub
SysErr:
MsgBox Error, vbInformation + vbOKOnly, ""
End Sub
'赋值
Public Sub SetExcelKey(r As Long, c As Long, str As String)
On Error GoTo SysErr
ExcelSheet.Cells(r, c) = str
Exit Sub
SysErr:
MsgBox Error, vbInformation + vbOKOnly, ""
End Sub
'打开一个excel文档
Public Function OpenExcel(Fn As String) As Integer
On Error GoTo SysErr
Set ExcelApp = CreateObject("excel.application")
ExcelApp.Visible = False
ExcelApp.SheetsInNewWorkbook = 1
If Dir(Fn, vbDirectory) <> "" Then
Set ExcelBook = ExcelApp.Workbooks.Open(Fn)
Else
Set ExcelBook = ExcelApp.Workbooks.Add
End If
Set ExcelSheet = ExcelBook.Worksheets(1)
IsOpen = 1
OpenExcel = 0
Exit Function
SysErr:
IsOpen = 0
OpenExcel = 1
MsgBox Error, vbInformation + vbOKOnly, "打开excel"
End Function
'保存当前文档
Public Sub SaveExcel()
On Error GoTo SysErr
If IsOpen = 0 Then Exit Sub
ExcelBook.Save
Exit Sub
SysErr:
MsgBox Error, vbInformation + vbOKOnly, ""
End Sub
'另存为当前文档
Public Sub SaveAsExcel(NewFn As String)
On Error GoTo SysErr
If IsOpen = 0 Then Exit Sub
ExcelBook.SaveAs NewFn
Exit Sub
SysErr:
MsgBox Error, vbInformation + vbOKOnly, ""
End Sub
'关闭excel 文档
Public Sub QuitExcel()
On Error GoTo SysErr
IsOpen = 0
ExcelBook.Close
ExcelApp.Quit
Set ExcelApp = Nothing
Set ExcelBook = Nothing
Exit Sub
SysErr:
MsgBox Error, vbInformation + vbOKOnly, ""
End Sub
之后在窗体的按钮中加入以下调用代码
OpenExcel App.Path & "\发票表.xls" '打开模板如果没有找到模板会新建一个xls空文档
SetExcelKey rr, cc, "内容" ' rr行、cc列 写入内容'结束操作
SaveAsExcel App.Path
QuitExcel '关闭文档
在 SetExcelKey rr, cc, "内容" ' rr行、cc列 写入内容这里提示：ByRef argument type mismatch的错误，
应该怎么调用啊，谢谢
[解决办法]
rr,cc没有定义，SetExcelKey 已经声明rr,cc应为Long,所以会报错，在SetExcelKey rr, cc, "内容" 前面加上：
Dim rr as Long,cc As Long
rr=...
cc=...
[解决办法]
我一直使用的datagrid控件导出excel过程
'导出Private Sub LoadExport()If picView.Visible = False Then LoadViewDim xlApp As New Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.WorksheetDim xlQuery As Excel.QueryTableSet xlBook = xlApp.Workbooks().AddSet xlSheet = xlBook.Worksheets("sheet1")Set xlQuery = xlSheet.QueryTables.Add(rsLoadAdd, xlSheet.Range("a1 "))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 = TrueEnd WithxlQuery.FieldNames = TruexlQuery.Refreshcmdlg.Flags = 2cmdlg.Filter = "EXCEL文档(*.xls)"cmdlg.ShowSaveIf cmdlg.FileName <> "" Then xlApp.DisplayAlerts = False xlBook.SaveAs FileName:=cmdlg.FileName If MsgBox("导出成功,是否打开查看?", vbOKCancel, "导出EXCEL") = vbOK Then xlApp.Workbooks().Open cmdlg.FileName xlApp.Visible = True Else xlApp.Quit End IfEnd IfIf xlApp <> Null Then Set xlApp = NothingEnd Sub
[解决办法]