把MSHFlexGrid里数据导出至Excel

1、如何把 MSHFlexGrid 里的数据导出至 Excel？用 Adodc1 做了查询语句，结果显示在一个 MSHFlexGrid 里面。现在要求做一个按钮 (Command1 )，点击它就把 MSHFlexGrid 里显示的数据导出至 Excel 表中。就是一点这个 按钮，就会自动打开 Excel ，然后数据就已经进去了，方便编辑和打印。 要求：代码详细，直接复制到 Command1 下就能用。这块我不懂，所以不要搞什么子程序 调用之类的，要有子程序也给直接调用好。直接复制代码成功后，再追加 100 分。把这个弄完工程就结了，再不用受罪了，哈哈！ 以下是精简后的代码 , 不清楚你工作中的一些

2、细节 ,所以如有问题与我讨论Private Sub Command1_Click()MSFlexGrid1.Redraw = False ' 关闭表格重画，加快运行速度Set xlApp = CreateObject("Excel.Application") ' 创建 EXCEL 对象对账模板 .xls") ' 打开已经存在的 EXCEL 工件簿文件xlApp.Visible = True ' 设置 EXCEL 对象可见(或不可见)Set xlsheet = xlBook.Worksheets("Sheet1")

3、 ' 设置活动工作表For R = 0 To MSFlexGrid1.Rows - 1 ' 行循环For C = 0 To MSFlexGrid1.Cols - 1 ' 列循环 MSFlexGrid1.Row = RMSFlexGrid1.Col = C xlBook.Worksheets("Sheet1").Cells(R + 1, C + 1) = MSFlexGrid1.Text ' 保存到 EXCELNext CNext RMSFlexGrid1.Redraw = True'xlsheet.PrintOut ' 打印工

4、作表xlApp.DisplayAlerts = False ' 不进行安全提示 'xlBook.Close (False)'关闭工作簿Set xlsheet = NothingSet xlBook = Nothing xlApp.QuitSet xlApp = Nothing End Sub11).Value = MHFGrid.TextMatrix(i,& Err.Description, vbOKOnly,面的代码就也能导出到 EXCELDimxlAppAs Excel.ApplicationDimxlBookAs Excel.WorkbookDimxlSh

5、eetAs Excel.WorksheetDimi AsLong, J As LongOnError GoTo ErrorHandleSetxlApp= CreateObject( "Excel.Application ")SetxlBook= SetxlSheet= xlBook.Worksheets(1)For i= 0 To MHFGrid.Rows - 1For J = 0 To MHFGrid.Cols xlSheet.Cells(i + 1, J + J)Next JNext i xlSheet.Application.Visible = True Set xl

6、Sheet = NothingSet xlBook = NothingSet xlApp = Nothing Exit SubErrorHandle:MsgBox "错误： " & Err.Number & vbCrLf 运行错误 "如何将表中的数据导出到电子表格中作者：施进兵 有很多方法都可将数据库中某个表的数据导出到电子表格中，例如通过创建 Access.Application,可以利用Access本身的导出功能实现将表中的数据导出到电子表格中。 但是这种方法会占用较多的系统资源，并且缺乏通用性。如果一个数据库没有导出的功能怎 么办？下面的这段

7、程序代码利用记录集实现导出的功能,这种做法的好处是显而易见的：你 可以控制要导出的数据,而不用将整个表的内容都导出到电子表格中。为简单起见下面的程 序代码仍将整个表的数据导出到电子表格中。如果你有兴趣的话,对下面的代码稍加改动就 可做成更为通用的一个类或是一个控件。首先在窗体上添加一个标签控件和一个命令按钮,然后在工程中添加对 DAO 引用。利用下 面的程序代码就可将表中的数据导出到电子表格中。Option ExplicitPrivate Sub Command1_Click()DimtempDBAs DatabaseDimi AsInteger' 循环计数器Dimj AsIntege

8、rDimrCountAs Long' 记录的个数Dimxl AsObject' OLE 自动化对象DimSn AsRecordsetScreen.MousePointer =11Label1.Caption ="打开数据库 . "Label1.RefreshSet tempDB = Workspaces(0).OpenDatabase( "Nwind.mdb ") Label1.Caption ="创建 Excel 对象. "Label1.RefreshSet xl = CreateObject( "Exce

9、l.Sheet.8 ")Label1.Caption ="创建快照型记录集 . "Label1.RefreshSet Sn = tempDB.OpenRecordset( "Customers ", dbOpenSnapshot) If Sn.RecordCount > 0 ThenLabel1.Caption = "将字段名添加到电子表格中"Label1.RefreshFor i =0 To Sn.Fields.Count -1xl.Worksheets(1).cells(1, i + 1).Value = Sn(i

10、).Name NextSn.MoveLastSn.MoveFirst rCount = Sn.RecordCount' 在记录中循环 i =0Do While Not Sn.EOF Label1.Caption = "Record:"& Str(i +1)&" of "&_Str(rCount)Label1.RefreshFor j =0 To Sn.Fields.Count -1' 加每个字段的值加到工作表中If Sn(j).Type < 11 Then xl.Worksheets(1).cells(i +

11、 2, j + 1).ValueSn(j)Else' 处理 Memo 和 LongBinary 类型的字段xl.Worksheets(1).cells(i + 2, j + 1).Value"Memo orBinary Data "End IfNext jSn.MoveNexti = i + 1Loop' 保存工作表Label1.Caption = "保存文件 . "Label1.Refreshxl.SaveAs "c:Customers.XLS "' 从内存中删除 Excel 对象Label1.Caption

12、 = "退出 Excel "Label1.RefreshElse' 没有记录End If' 清除Label1.Caption = "清除对象 "Label1.RefreshSet xl = NothingSet Sn = NothingSet tempDB = NothingScreen.MousePointer = 0 ' 恢复鼠标指针 Label1.Caption = "Ready "Label1.RefreshEnd SubPrivate Sub Form_Load() Label1.AutoSize =

13、 True Label1.Caption = "Ready " Label1.RefreshEnd Sub给你个我用的方法，很好用'Option Explicitn*''* 名称： ExportToExcel''* 功能：导出数据到 EXCEL''* 用法： ExporToExcel 记录集，标题n*'Public Function ExportToExcel(Rs_Data As ADODB.Recordset, CenterHeader As String) As Boolean ' Dim Iro

14、wcount As Integer' Dim Icolcount As Integer' Dim SA As String' Dim xlApp As New Excel.Application' Dim xlBook As Excel.Workbook' Dim xlSheet As Excel.Worksheet' Dim xlQuery As Excel.QueryTable'On Error GoTo err' With Rs_Data' If .state = adStateOpen Then' .Clo

15、se' End If' .ActiveConnection = DBConn' .CursorLocation = adUseClient' .CursorType = adOpenStatic' .LockType = adLockReadOnly' '.Source = strOpen' .Open' End With' With Rs_Data' ' 记录总数' Irowcount = .RecordCount' ' 字段总数' Icolcount = .Fie

16、lds.Count' End With' Set xlApp = CreateObject("Excel.Application")' Set xlBook = Nothing' Set xlSheet = Nothing' Set xlBook = xlApp.Workbooks().add' Set xlSheet = xlBook.Worksheets("sheet1")' xlApp.Visible = False' ' 添加查询语句，导入 EXCEL 数据' Set

17、 xlQuery = xlSheet.QueryTables.add(Rs_Data, xlSheet.Range("a1")' With xlQuery' .FieldNames = True' .RowNumbers = False' .FillAdjacentFormulas = False' .PreserveFormatting = True' .RefreshOnFileOpen = False' .BackgroundQuery = True' .RefreshStyle = xlInsertDe

18、leteCells' .SavePassword = True' .SaveData = True' .AdjustColumnWidth = True' .RefreshPeriod = 0' .PreserveColumnInfo = True' End With' xlQuery.FieldNames = True ' 显示字段名' xlQuery.Refresh' If CenterHeader = " 开停历史纪录 " Then' SA = "A1:H" +

19、 CStr(Irowcount + 1)' ElseIf CenterHeader = " 锁闭阀运行状态 " Then' SA = "A1:F" + CStr(Irowcount + 1)' ElseIf CenterHeader = " 锁闭阀分配表 " Then' SA = "A1:F" + CStr(Irowcount + 1)' ElseIf CenterHeader = " 用户信息汇总 " Then' SA = "A1:I&

20、quot; + CStr(Irowcount + 1)' ElseIf CenterHeader = " 锁闭阀开停设置 " Then' SA = "A1:H" + CStr(Irowcount + 1)' ElseIf CenterHeader = " 房间信息 " Then' SA = "A1:J" + CStr(Irowcount + 1)' End If' With xlSheet' '.Range(.Cells(1, 1), .Cells(1

21、, Icolcount).Font.Name = " 宋体 "' '.Range(.Cells(1, 1), .Cells(1, Icolcount).Font.Size = 10' ' 标题字体加粗' '.Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount).Borders.LineStyle = xlContinuous ' ' 设表格边框样式'字体' .Range(SA).Font.Name = " 宋体 "'

22、 .Range(SA).Font.Size = 10' ' 设标题为黑体字' .Range(.Cells(1, 1), .Cells(1, Icolcount).Font.Bold = True'列宽度' If CenterHeader = " 开停历史纪录 " Then' .Columns("A:A").ColumnWidth = 8.63' .Columns("B:B").ColumnWidth = 11.38' .Columns("C:C").C

23、olumnWidth = 12.63' .Columns("D:D").ColumnWidth = 6.75' .Columns("E:E").ColumnWidth = 13.31' .Columns("F:F").ColumnWidth = 7' .Columns("G:G").ColumnWidth = 7' .Columns("H:H").ColumnWidth = 7.63' End If' ' 对齐' .Rang

24、e(SA).HorizontalAlignment = xlCenter' .Range(SA).VerticalAlignment = xlCenter' ' 边框' .Range(SA).Borders(xlDiagonalDown).LineStyle = xlNone' .Range(SA).Borders(xlDiagonalUp).LineStyle = xlNone' With .Range(SA).Borders(xlEdgeLeft)' .LineStyle = xlContinuous' .Weight = x

25、lThin' .ColorIndex = xlAutomatic' End With' With .Range(SA).Borders(xlEdgeTop)' .LineStyle = xlContinuous' .Weight = xlThin' .ColorIndex = xlAutomatic' End With' With .Range(SA).Borders(xlEdgeBottom)' .LineStyle = xlContinuous' .Weight = xlThin' .ColorInde

26、x = xlAutomatic' End With' With .Range(SA).Borders(xlEdgeRight)' .LineStyle = xlContinuous' .Weight = xlThin' .ColorIndex = xlAutomatic' End With' With .Range(SA).Borders(xlInsideVertical)' .LineStyle = xlContinuous' .Weight = xlThin' .ColorIndex = xlAutomatic

27、' End With' With .Range(SA).Borders(xlInsideHorizontal)' .LineStyle = xlContinuous' .Weight = xlThin' .ColorIndex = xlAutomatic' End With' End With' ' 页面设置' With xlSheet.PageSetup' .LeftHeader = "" & "" & Chr(10) & "&am

28、p;10单位名称： "' .CenterHeader = "&"" 宋体 ,加粗 ""&16" & CenterHeader' .RightHeader = "&""Times New Roman, 常规 ""&10" & "" & Chr(10) & "&""宋体 , 常规 "" 打印日期 &&quo

29、t;"Times New Roman, 常规"":&D "' .LeftFooter = ""' .CenterFooter = " 第 &P 页，共 &N 页 "' .RightFooter = ""' .PrintHeadings = False' .PrintGridlines = True' .PrintComments = xlPrintNoComments' '.PrintQuality = 20

30、0' .CenterHorizontally = False' .CenterVertically = False' .Draft = False' .PaperSize = xlPaperA4' .FirstPageNumber = xlAutomatic' .Order = xlDownThenOver' .BlackAndWhite = False' .Zoom = 100' End With' xlApp.Application.Visible = True' ' 交还控制给 Excel&#

31、39; Set xlApp = Nothing '' Set xlBook = Nothing' Set xlSheet = Nothing' Exit Function'err:' MsgBox err.Description, vbInformation, MsgTitle 'End FunctionVB将VB表格中的数据导出到Excel(2006-5-14 17:30:00)【收藏】【评论】【打印】 【关闭】步骤介绍：首先在VB建一个MSFlexGrid表格，再连接到数据库，将数据库的表的资料显示到表格中，最后调用ExportExc

32、ell ()函数将表格中数据导岀到Excel.第一步：在VB建一个MSFlexGrid表格，再连接到数据库，将数据库的表的资料显示到表格中，这个代码我就不写了。大家应该都知道写把。第二步：将以下函数代码放到模块里，只需改3处代码，则可实现导岀功能，其他地方不用改。/* IntToChr (这个函数不要做任何修改)说明：将网格的列数转换成 Excel中的字符形表示方式*/Public Function lntToChr(iRow1 As Integer, iCol1 As Integer, iRow2 As Integer, iCol2 As Integer) As StringDim i As

33、 Integer, j As Integer, tmpi As IntegerDim Tmpstr(1 To 2) As StringIf iCol1 < 1 Or iCol1 > 256 Or iCol2 < 1 Or iCol2 > 256 ThenIntToChr =""Exit FunctionEnd Ifj = iColl Mod 26If j = 0 Theni = (iColl 26) - 1j = 26Elsei = (iCol1 26)End IfIf i > 0 ThenTmpstr(1) = Chr(64 + i) &am

34、p; Chr(64 + j)ElseTmpstr(1) = Chr(64 + j)End Ifj = iCol2 Mod 26If j = 0 Theni = (iCol2 26) - 1j = 26Elsei = (iCol2 26)End IfIf i > 0 ThenTmpstr(2) = Chr(64 + i) & Chr(64 + j)ElseTmpstr(2) = Chr(64 + j)End IfIntToChr = Tmpstr(1) & iRow1 & ":" & Tmpstr(2) & iRow2End Fu

35、nction首先先作一个Excel表的模式，如下：学生资料将以次格式显示岀来ABCDEF123学生资料表45ID姓名性别73910/*ExportExcel1 （此函数将以如上表的模式显示数据）说明：以一般的形式导出学员基本信息表此函数只要修改3个地方就可以导岀数据到Excel表中*/Public Sub ExportExcel1(ByVal MyObject As Object)Dim i As Integer, j As Integer, Rows As Integer, Cols As IntegerDim Firsti As IntegerDim NashXl As Object, t

36、mpChr As StringDim excel_app As Object, excel_sheet As ObjectDim xlNone As Integer, xlEdgeLeft As Integer, xlContinuous As Integer, xlThin As IntegerDim xlAutomatic As Integer, xlEdgeTop As Integer, xIEdgeBottom As IntegerDim xlEdgeRight As Integer, xlInsideVertical As Integer, xlInsideHorizontal As

37、 IntegerDim xlDiagonalDown As Integer, xlDiagonalUp As Integer, xlCenter As Integer, xlMedium As IntegerDim xlNormal As Integer'Dim fso As New FileSystemObjectScreen.MousePointer = 11'定义Excel中关于边框和文字位置的常量xlContinuous = 1xlThin = 2xlDiagonalDown = 5xlDiagonalUp = 6xlEdgeLeft = 7xlEdgeTop = 8x

38、lEdgeBottom = 9xlEdgeRight = 10xllnsideVertical = 11xllnsideHorizontal = 12xINone = -4142xIAutomatic = -4105xlCenter = -4108xlMedium = -4138xlNormal = -4143打开ExcelRows = MyObject.RowsCols = MyObject.ColsSet excel_app = CreateObject("excel.application")'新增一个空的 Excel的Sheet页nnnnnnnnnnnnnn

39、nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn/*第一处：“ App.Path &"表格学员信息表.xls表示你的Excel表格模式的地址，修改成你的Excel表格模式的地址就行了*/表格学员信息表.xls"If Val(excel_app.Application.Version) >= 8 ThenSet excel_sheet = excel_app.ActiveSheetElseSet excel_sheet = excel_appEnd IfSet NashXl = excel_sheet.Application/*第二处：

40、修改下面的 2个for循环。 rows表示MSFlexGrid表格的行数，cols表示MSFlexGrid表格的列数， 2个 循环既是将 MSFlexGrid表格表格中所有的数据导出到Excel表中。 excel_sheet.Cells( x, y ).value表示Excel中的单元格，参数x表示行数，y表示列数，同过x,y来确定将要存放数据的单元格，".value"既设置此单元格的值。MyObject是ExportExcel1函数的参数，用来指示 MSFlexGrid表格。 MyObject.TextMatrix( x, y )用来获得位于 MSFlexGrid表格中x

41、行 y列的值。 通过这2个for循环则将MSFlexGrid表格中的数据添加到了Excel中。但是添加到 Excel中的数据并没有用线将数据行列分开和框起来，因此要用到IntToChr ()函数来实现这个功能。第三处修改的也正是IntToChr ()函数的参数。*/For i = 1 To Rows - 1For j = 1 To Colsexcel_sheet.Cells( i + 5, j + 2 ).Value = MyObject.TextMatrix(i, j - 1)Next jNext i'定义边框/*第三处修改：tmpChr = IntToChr( iRow1 As I

42、nteger, iCol1 As Integer, iRow2 As Integer, iCol2 As Integer ), 参数 iRow1,iCol1 表示 线框在Excel中的起始处的单元格，如图：ABCDEF123学生资料表45ID姓名性别618910该Excel表格的边框起始处是(6,3),既6行3列。 iRow2,iCol2表示线框在Excel中的结束处的单元格，iRow2参数设定:由于导入到Excel中的数据的行数由MSFlexGrid中的数据的行数决定的，所以先用“Rows 1”表示MSFlexGrid有多少的数据(减1是因为 MSFlexGrid第一行是标题，不是数据)，然后在加用“Rows 1"加“5因为