Public Sub Export(frmName As Form,FlexGridName As String) Dim xlApp As Object 'Excel.Application Dim xlBook As Object 'Excel.Workbook Dim xlSheet As Object 'Excel.Worksheet Screen.MousePointer = vbHourglass On Error GoTo Err_Proc Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) '向表中添加数据 Dim intRowIndex As Integer Dim intColIndex As Integer With frmName.Controls(FlexGridName) '查找控件 '填充数据到Sheet1 For intRowIndex = 0 To .Rows - 1 For intColIndex = 0 To .Cols - 1 xlSheet.Cells(intRowIndex + 1,intColIndex + 1).Value = "'" & .TextMatrix(intRowIndex,intColIndex) Next intColIndex Next intRowIndex End With xlApp.Visible = True Screen.MousePointer = vbDefault Exit Sub Err_Proc: Screen.MousePointer = vbDefault MsgBox "请确认您的电脑已安装Excel!",vbExclamation,"提示" End Sub
Export Me,"MSHFlexGrid1"