请问：如何将VSFlexGrid中的数据（包括表头）导出到EXCEL电子表格？

[Tomcat_F14]

请问：如何将VSFlexGrid中的数据（包括表头）导出到EXCEL电子表格？有没有相关的例子

[wynbfqny]

vsflexgrid读出数据请看相应例子
写出excel如下：
On Error GoTo error1
Dim strSource As String, strDestination As String
Dim mobjExcel As Excel.Application
Dim mobjworkbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
strSource = App.Path & "\模版.xls"
strDestination = App.Path & "\Temp.xls"
FileCopy strSource, strDestination
Set mobjExcel = New Excel.Application
Set mobjExcel = CreateObject("Excel.Application")
mobjExcel.Visible = False
Set mobjworkbook = mobjExcel.Workbooks.Open(strDestination)
Set xlsheet = mobjworkbook.Worksheets("sheet")


With xlsheet

.Cells(i, j ) = 相应数据
End With

[chcky]

'Excel 是一个非常优秀的报表制作软件，用VBA可以控制其生成优秀的报表，本文通过添加查询语句的方法，即用Excel中的获取外部数据的功能将数据很快地从一个查询语句中捕获到EXCEL中，比起往每个CELL里写数据的方法提高许多倍。
'在程序中引用Microsoft Excel 9.0 Object Library，将下文加入到一个模块中,窗体中调用如下ExporToExcel("select * from table")。则实现快速将数据导出到EXCEL中。

Public Function ExportToExcel(ByVal strOpen As String, Title As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL'* 用法：ExporToExcel(sql查询字符串)
'*********************************************************
On Error GoTo er
Screen.MousePointer = 11
Dim Rs_Data 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

' With Rs_Data
' If .State = adStateOpen Then
' .Close
' End If
' .ActiveConnection = cn
' .CursorLocation = adUseClient
' .CursorType = adOpenStatic
' .LockType = adLockReadOnly
' .Source = strOpen
' .Open
' End With
Set Rs_Data = Open_rst_from_str(strOpen)
With Rs_Data
If .RecordCount < 1 Then
MsgBox ("没有记录!")
Screen.MousePointer = 0
Exit Function
End If
'记录总数
Irowcount = .RecordCount
'字段总数
Icolcount = .Fields.Count
End With

Set xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().add
Set xlSheet = xlBook.Worksheets("sheet1")


'添加查询语句，导入EXCEL数据
Set xlQuery = xlSheet.QueryTables.add(Rs_Data, 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 = True
End With

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

Dim i As Integer, Zd As String
With xlSheet
For i = 1 To Icolcount
Zd = .Range(.Cells(1, 1), .Cells(1, Icolcount)).Item(1, i)
.Range(.Cells(1, 1), .Cells(1, Icolcount)).Item(1, i) = Lm_YwToZw(Zd)
Next
.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
'设标题为黑体字
' .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
'标题字体加粗
.Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
' .Range(.Cells(Irowcount + 2, Icolcount)).Text = Zje
'设表格边框样式
End With
xlApp.Visible = True
xlApp.Application.Visible = True
Set xlApp = Nothing '"交还控制给Excel
Set xlBook = Nothing
Set xlSheet = Nothing
Screen.MousePointer = 0
Exit Function
er:
Dispose_Err
End Function