MSFlexGrid1如何导出Excel表格
展开全部
贴一段我写的VB源码,希望对你有用
Dim i, j As Integer
Dim objExlApp As New Excel.Application
Dim objExlBook As New Excel.Workbook
Dim objExlSheet As New Excel.Worksheet
Dim Wsheet As String
Wsheet = LabN.Caption
If MSFG1.Rows > 1 Then
'另存到XLS文件
' 设置“取消”为 True
CommonDialog1.CancelError = True
On Error GoTo errHandler
CommonDialog1.Filter = "Excel文件(*.xls)|*.xls|所有文件|*.*"
CommonDialog1.FileName = TxtProduction.Text & Format(Now, "YYYYMMDD") & ".XLS"
CommonDialog1.ShowSave
objExlApp.Visible = False
objExlApp.DisplayAlerts = False
objExlApp.ScreenUpdating = False
'创建新的工作薄
Set objExlBook = objExlApp.Workbooks.Add
'设置要使用的工作表
Set objExlSheet = objExlBook.Sheets(1)
objExlSheet.Cells(1, 1) = "生产统计"
objExlSheet.Cells(2, 1) = LabT.Caption
'objExlSheet.Cells(3, 1) = "生产编排顺序"
'objExlSheet.Cells(3, 2) = "要求出版时间"
' objExlSheet.Cells(3, 7) = "备注"
For i = 0 To MSFG1.Rows - 1
objExlSheet.Cells(i + 3, 1) = MSFG1.TextMatrix(i, 1)
objExlSheet.Cells(i + 3, 2) = MSFG1.TextMatrix(i, 2)
objExlSheet.Cells(i + 3, 3) = MSFG1.TextMatrix(i, 3)
'objExlSheet.Cells(i + 3, 4) = MSFG1.TextMatrix(i, 15)
objExlSheet.Cells(i + 3, 5) = MSFG1.TextMatrix(i, 4)
objExlSheet.Cells(i + 3, 6) = MSFG1.TextMatrix(i, 5)
objExlSheet.Cells(i + 3, 7) = MSFG1.TextMatrix(i, 6)
objExlSheet.Cells(i + 3, 8) = MSFG1.TextMatrix(i, 7)
objExlSheet.Cells(i + 3, 9) = MSFG1.TextMatrix(i, 8)
objExlSheet.Cells(i + 3, 10) = MSFG1.TextMatrix(i, 9)
objExlSheet.Cells(i + 3, 11) = MSFG1.TextMatrix(i, 10)
objExlSheet.Cells(i + 3, 12) = MSFG1.TextMatrix(i, 11)
objExlSheet.Cells(i + 3, 13) = MSFG1.TextMatrix(i, 12)
objExlSheet.Cells(i + 3, 14) = MSFG1.TextMatrix(i, 13)
objExlSheet.Cells(i + 3, 15) = MSFG1.TextMatrix(i, 14)
Next i
sFileName = CommonDialog1.FileName
objExlSheet.SaveAs sFileName
objExlApp.Visible = True
objExlApp.ScreenUpdating = True
objExlApp.DisplayAlerts = True
objExlApp.Application.quit
Set objExlSheet = Nothing
Set objExlBook = Nothing
Set objExlApp = Nothing
'objExlBook.Close
MsgBox "文件已生成,在:" & sFileName
Else
MsgBox "没有可导出的数据,请先进行查询!"
End If
errHandler:
Exit Sub
Dim i, j As Integer
Dim objExlApp As New Excel.Application
Dim objExlBook As New Excel.Workbook
Dim objExlSheet As New Excel.Worksheet
Dim Wsheet As String
Wsheet = LabN.Caption
If MSFG1.Rows > 1 Then
'另存到XLS文件
' 设置“取消”为 True
CommonDialog1.CancelError = True
On Error GoTo errHandler
CommonDialog1.Filter = "Excel文件(*.xls)|*.xls|所有文件|*.*"
CommonDialog1.FileName = TxtProduction.Text & Format(Now, "YYYYMMDD") & ".XLS"
CommonDialog1.ShowSave
objExlApp.Visible = False
objExlApp.DisplayAlerts = False
objExlApp.ScreenUpdating = False
'创建新的工作薄
Set objExlBook = objExlApp.Workbooks.Add
'设置要使用的工作表
Set objExlSheet = objExlBook.Sheets(1)
objExlSheet.Cells(1, 1) = "生产统计"
objExlSheet.Cells(2, 1) = LabT.Caption
'objExlSheet.Cells(3, 1) = "生产编排顺序"
'objExlSheet.Cells(3, 2) = "要求出版时间"
' objExlSheet.Cells(3, 7) = "备注"
For i = 0 To MSFG1.Rows - 1
objExlSheet.Cells(i + 3, 1) = MSFG1.TextMatrix(i, 1)
objExlSheet.Cells(i + 3, 2) = MSFG1.TextMatrix(i, 2)
objExlSheet.Cells(i + 3, 3) = MSFG1.TextMatrix(i, 3)
'objExlSheet.Cells(i + 3, 4) = MSFG1.TextMatrix(i, 15)
objExlSheet.Cells(i + 3, 5) = MSFG1.TextMatrix(i, 4)
objExlSheet.Cells(i + 3, 6) = MSFG1.TextMatrix(i, 5)
objExlSheet.Cells(i + 3, 7) = MSFG1.TextMatrix(i, 6)
objExlSheet.Cells(i + 3, 8) = MSFG1.TextMatrix(i, 7)
objExlSheet.Cells(i + 3, 9) = MSFG1.TextMatrix(i, 8)
objExlSheet.Cells(i + 3, 10) = MSFG1.TextMatrix(i, 9)
objExlSheet.Cells(i + 3, 11) = MSFG1.TextMatrix(i, 10)
objExlSheet.Cells(i + 3, 12) = MSFG1.TextMatrix(i, 11)
objExlSheet.Cells(i + 3, 13) = MSFG1.TextMatrix(i, 12)
objExlSheet.Cells(i + 3, 14) = MSFG1.TextMatrix(i, 13)
objExlSheet.Cells(i + 3, 15) = MSFG1.TextMatrix(i, 14)
Next i
sFileName = CommonDialog1.FileName
objExlSheet.SaveAs sFileName
objExlApp.Visible = True
objExlApp.ScreenUpdating = True
objExlApp.DisplayAlerts = True
objExlApp.Application.quit
Set objExlSheet = Nothing
Set objExlBook = Nothing
Set objExlApp = Nothing
'objExlBook.Close
MsgBox "文件已生成,在:" & sFileName
Else
MsgBox "没有可导出的数据,请先进行查询!"
End If
errHandler:
Exit Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询