把MSHFlexGrid里数据导出至Excel.docx
- 文档编号:29294099
- 上传时间:2023-07-22
- 格式:DOCX
- 页数:20
- 大小:27.45KB
把MSHFlexGrid里数据导出至Excel.docx
《把MSHFlexGrid里数据导出至Excel.docx》由会员分享,可在线阅读,更多相关《把MSHFlexGrid里数据导出至Excel.docx(20页珍藏版)》请在冰豆网上搜索。
把MSHFlexGrid里数据导出至Excel
如何把MSHFlexGrid里的数据导出至Excel?
用Adodc1做了查询语句,结果显示在一个MSHFlexGrid里面。
现在要求做一个按钮(Command1),点击它就把MSHFlexGrid里显示的数据导出至Excel表中。
就是一点这个按钮,就会自动打开Excel,然后数据就已经进去了,方便编辑和打印。
要求:
代码详细,直接复制到Command1下就能用。
这块我不懂,所以不要搞什么子程序调用之类的,要有子程序也给直接调用好。
直接复制代码成功后,再追加100分。
把这个弄完工程就结了,再不用受罪了,哈哈!
以下是精简后的代码,不清楚你工作中的一些细节,所以如有问题与我讨论
PrivateSubCommand1_Click()
MSFlexGrid1.Redraw=False'关闭表格重画,加快运行速度
SetxlApp=CreateObject("Excel.Application")'创建EXCEL对象
SetxlBook=xlApp.Workbooks.Open(App.Path&"\对账模板.xls")'打开已经存在的EXCEL工件簿文件
xlApp.Visible=True'设置EXCEL对象可见(或不可见)
Setxlsheet=xlBook.Worksheets("Sheet1")'设置活动工作表
ForR=0ToMSFlexGrid1.Rows-1'行循环
ForC=0ToMSFlexGrid1.Cols-1'列循环
MSFlexGrid1.Row=R
MSFlexGrid1.Col=C
xlBook.Worksheets("Sheet1").Cells(R+1,C+1)=MSFlexGrid1.Text'保存到EXCEL
NextC
NextR
MSFlexGrid1.Redraw=True
'xlsheet.PrintOut'打印工作表
xlApp.DisplayAlerts=False'不进行安全提示
'xlBook.Close(False)'关闭工作簿
Setxlsheet=Nothing
SetxlBook=Nothing
xlApp.Quit
SetxlApp=Nothing
EndSub
下面的代码就也能导出到EXCEL
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim i As Long, J As Long
On Error GoTo ErrorHandle
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets
(1)
For i = 0 To MHFGrid.Rows - 1
For J = 0 To MHFGrid.Cols - 1
xlSheet.Cells(i + 1, J + 1).Value = MHFGrid.TextMatrix(i, J)
Next J
Next i
xlSheet.Application.Visible = True
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
ErrorHandle:
MsgBox "错误:
" & Err.Number & vbCrLf & Err.Description, vbOKOnly, "运行错误"
如何将表中的数据导出到电子表格中
作者:
施进兵
有很多方法都可将数据库中某个表的数据导出到电子表格中,例如通过创建Access.Application,可以利用Access本身的导出功能实现将表中的数据导出到电子表格中。
但是这种方法会占用较多的系统资源,并且缺乏通用性。
如果一个数据库没有导出的功能怎么办?
下面的这段程序代码利用记录集实现导出的功能,这种做法的好处是显而易见的:
你可以控制要导出的数据,而不用将整个表的内容都导出到电子表格中。
为简单起见下面的程序代码仍将整个表的数据导出到电子表格中。
如果你有兴趣的话,对下面的代码稍加改动就可做成更为通用的一个类或是一个控件。
首先在窗体上添加一个标签控件和一个命令按钮,然后在工程中添加对DAO引用。
利用下面的程序代码就可将表中的数据导出到电子表格中。
Option Explicit
Private Sub Command1_Click()
Dim tempDB As Database
Dim i As Integer ' 循环计数器
Dim j As Integer
Dim rCount As Long ' 记录的个数
Dim xl As Object ' OLE自动化对象
Dim Sn As Recordset
Screen.MousePointer = 11
Label1.Caption = "打开数据库..."
Label1.Refresh
Set tempDB = Workspaces(0).OpenDatabase("Nwind.mdb")
Label1.Caption = "创建Excel对象..."
Label1.Refresh
Set xl = CreateObject("Excel.Sheet.8")
Label1.Caption = "创建快照型记录集..."
Label1.Refresh
Set Sn = tempDB.OpenRecordset("Customers", dbOpenSnapshot)
If Sn.RecordCount > 0 Then
Label1.Caption = "将字段名添加到电子表格中"
Label1.Refresh
For i = 0 To Sn.Fields.Count - 1
xl.Worksheets
(1).cells(1, i + 1).Value = Sn(i).Name
Next
Sn.MoveLast
Sn.MoveFirst
rCount = Sn.RecordCount
' 在记录中循环
i = 0
Do While Not Sn.EOF
Label1.Caption = "Record:
" & Str(i + 1) & " of" & _
Str(rCount)
Label1.Refresh
For j = 0 To Sn.Fields.Count - 1
' 加每个字段的值加到工作表中
If Sn(j).Type < 11 Then
xl.Worksheets
(1).cells(i + 2, j + 1).Value = Sn(j)
Else
' 处理Memo和LongBinary 类型的字段
xl.Worksheets
(1).cells(i + 2, j + 1).Value = "Memo or Binary Data"
End If
Next j
Sn.MoveNext
i = i + 1
Loop
' 保存工作表
Label1.Caption = "保存文件..."
Label1.Refresh
xl.SaveAs "c:
\Customers.XLS"
'从内存中删除Excel对象
Label1.Caption = "退出Excel"
Label1.Refresh
xl.Application.Quit
Else
' 没有记录
End If
' 清除
Label1.Caption = "清除对象"
Label1.Refresh
Set xl = Nothing
Set Sn = Nothing
Set tempDB = Nothing
Screen.MousePointer = 0 ' 恢复鼠标指针
Label1.Caption = "Ready"
Label1.Refresh
End Sub
Private Sub Form_Load()
Label1.AutoSize = True
Label1.Caption = "Ready"
Label1.Refresh
End Sub
给你个我用的方法,很好用
'OptionExplicit
''*********************************************************
''*名称:
ExportToExcel
''*功能:
导出数据到EXCEL
''*用法:
ExporToExcel记录集,标题
''*********************************************************
'PublicFunctionExportToExcel(Rs_DataAsADODB.Recordset,CenterHeaderAsString)AsBoolean
'DimIrowcountAsInteger
'DimIcolcountAsInteger
'DimSAAsString
'DimxlAppAsNewExcel.Application
'DimxlBookAsExcel.Workbook
'DimxlSheetAsExcel.Worksheet
'DimxlQueryAsExcel.QueryTable
'OnErrorGoToerr
'WithRs_Data
'If.state=adStateOpenThen
'.Close
'EndIf
'.ActiveConnection=DBConn
'.CursorLocation=adUseClient
'.CursorType=adOpenStatic
'.LockType=adLockReadOnly
''.Source=strOpen
'.Open
'EndWith
'WithRs_Data
''记录总数
'Irowcount=.RecordCount
''字段总数
'Icolcount=.Fields.Count
'EndWith
'SetxlApp=CreateObject("Excel.Application")
'SetxlBook=Nothing
'SetxlSheet=Nothing
'SetxlBook=xlApp.Workbooks().add
'SetxlSheet=xlBook.Worksheets("sheet1")
'xlApp.Visible=False
''添加查询语句,导入EXCEL数据
'SetxlQuery=xlSheet.QueryTables.add(Rs_Data,xlSheet.Range("a1"))
'WithxlQuery
'.FieldNames=True
'.RowNumbers=False
'.FillAdjacentFormulas=False
'.PreserveFormatting=True
'.RefreshOnFileOpen=False
'.BackgroundQuery=True
'.RefreshStyle=xlInsertDeleteCells
'.SavePassword=True
'.SaveData=True
'.AdjustColumnWidth=True
'.RefreshPeriod=0
'.PreserveColumnInfo=True
'EndWith
'xlQuery.FieldNames=True'显示字段名
'xlQuery.Refresh
'IfCenterHeader="开停历史纪录"Then
'SA="A1:
H"+CStr(Irowcount+1)
'ElseIfCenterHeader="锁闭阀运行状态"Then
'SA="A1:
F"+CStr(Irowcount+1)
'ElseIfCenterHeader="锁闭阀分配表"Then
'SA="A1:
F"+CStr(Irowcount+1)
'ElseIfCenterHeader="用户信息汇总"Then
'SA="A1:
I"+CStr(Irowcount+1)
'ElseIfCenterHeader="锁闭阀开停设置"Then
'SA="A1:
H"+CStr(Irowcount+1)
'ElseIfCenterHeader="房间信息"Then
'SA="A1:
J"+CStr(Irowcount+1)
'EndIf
'WithxlSheet
''.Range(.Cells(1,1),.Cells(1,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="宋体"
'.Range(SA).Font.Size=10
''设标题为黑体字
'.Range(.Cells(1,1),.Cells(1,Icolcount)).Font.Bold=True
'列宽度
'IfCenterHeader="开停历史纪录"Then
'.Columns("A:
A").ColumnWidth=8.63
'.Columns("B:
B").ColumnWidth=11.38
'.Columns("C:
C").ColumnWidth=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
'EndIf
''对齐
'.Range(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=xlThin
'.ColorIndex=xlAutomatic
'EndWith
'With.Range(SA).Borders(xlEdgeTop)
'.LineStyle=xlContinuous
'.Weight=xlThin
'.ColorIndex=xlAutomatic
'EndWith
'With.Range(SA).Borders(xlEdgeBottom)
'.LineStyle=xlContinuous
'.Weight=xlThin
'.ColorIndex=xlAutomatic
'EndWith
'With.Range(SA).Borders(xlEdgeRight)
'.LineStyle=xlContinuous
'.Weight=xlThin
'.ColorIndex=xlAutomatic
'EndWith
'With.Range(SA).Borders(xlInsideVertical)
'.LineStyle=xlContinuous
'.Weight=xlThin
'.ColorIndex=xlAutomatic
'EndWith
'With.Range(SA).Borders(xlInsideHorizontal)
'.LineStyle=xlContinuous
'.Weight=xlThin
'.ColorIndex=xlAutomatic
'EndWith
'EndWith
''页面设置
'WithxlSheet.PageSetup
'.LeftHeader=""&""&Chr(10)&"&10单位名称:
"
'.CenterHeader="&""宋体,加粗""&16"&CenterHeader
'.RightHeader="&""TimesNewRoman,常规""&10"&""&Chr(10)&"&""宋体,常规""打印日期&""TimesNewRoman,常规"":
&D"
'.LeftFooter=""
'.CenterFooter="第&P
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- MSHFlexGrid 数据 导出 Excel
![提示](https://static.bdocx.com/images/bang_tan.gif)