2024年5月25日发(作者：)

VB高效导入Excel2003和Excel2007文件到MSHFlexGrid控件显示

VB高效导入Excel2003和Excel2007文件到MSHFlexGrid控件显示

2013年11月14日 作者：Admin

高效导入Excel2003和Excel2007文件到MSHFlexGrid控件显示

2.以前也有Excel导入通用功能，但速度有些慢一会把两种实现体式格式都供给出为参考对比。

一、原通用导入excel文件到MSHFlexGrid控件如下：Public Function DRExcel（fd As MSHFlexGrid，

CD1 As CommonDialog） As Boolean ""导入Excel文件函数 20120621孙广乐Dim file_name As

StringDim xlApp As New ationDim xlBook As okDim xlSheet As

eetDim xlQuery As ableDim r ""r为行数Dim i， jOn Error GoTo

a:file_name = ""fnum = = &H2With CD1 .Flags = cdlOFNHideReadOnly

& cdlOFNOverwritePrompt "" 设置过滤器 .Filter = "xls文档（*.xls）|*.xls|xlsx文档（*.xlsx）

|*.xlsx" ""只能导入xls这种文件格局 "" 指定缺省的过滤器 .FilterIndex = 1

"".ShowSave .ShowOpen file_name = .filenameEnd WithIf file_name = "" Then ""断定文件

是否存在 DRExcel = False Exit FunctionEnd If Set xlApp = CreateObject（"ation"）

Set xlBook = NothingSet xlSheet = NothingSet xlBook = oks（）.AddSet xlSheet =

eets（"sheet1"）""e = TrueSet xlBook =

（file_name）Set xlSheet = eets（1） ""测列数j = 1Do While （1， j）

<> "" j = j + 1Loopi = 1Do While （i， 1） <> "" i = i + 1LoopIf j = 1 Or i =

1 Then MsgBox "不容许导入空表！" DRExcel = False Exit FunctionEnd e =

= i - = j - 1 For i = 1 To For j = 1 To ""列数 trix

（i - 1， j - 1） = （i， j） Next jNext i ""e =

"""交还把握给gnment（0） = 0 ""物品代码MsgBox "完

成导入"ows = ols = me = ""DRExcel = Truea:End Function二、新办法，

高效把excel文件导入到MSHFlexGrid控件。这个很是高效。如下：

部件中添加Microsoft Common Dialog Control 6.0控件，然后拖入窗体中；

FGrid1改成表格控件名称（如MSHFlexGrid1），cd1改成Common Dialog控件名称（如

CommonDialog1）ols = 0Dim file_name As Stringfile_name = "" =

&H2With CD1 .Flags = cdlOFNHideReadOnly & cdlOFNOverwritePrompt "" 设置过滤

器 .Filter = "xls文档（*.xls）|*.xls|xlsx文档（*.xlsx）|*.xlsx" ""只能导入xls这种文件格局 "" 指

定缺省的过滤器 .FilterIndex = 1 "".ShowSave .ShowOpen file_name = .filenameEnd WithIf

file_name = "" Then ""断定文件是否存在 MsgBox （"选择的文件已经不存在了"） Exit

SubEnd IfDim excelid As ation Set excelid = New ation

（file_name） ow = 0

m CHART1 As

New tion， chart2 As New set Location =

adUseClient If Right（file_name， 5） = ".xlsx" Then ""excel2007版本以上

"Provider=.12.0;Persist Security Info=False;Data Source="

& file_name & ";Extended Properties=""Excel 12.0;HDR=Yes""" Else

"Provider=.4.0;Persist Security Info=False;Data Source=" &

file_name & ";Extended Properties=""Excel 8.0;HDR=Yes""" End If Dim rs As

set Set rs = hema（adSchemaTables） Dim ls_name As String

ls_name = （2）.Value ""取哪个sheet页数据 " * From [" & ls_name

& "]"， CHART1， adOpenKeyset， adLockOptimistic Set urce = chart2Set

CHART1 = NothingSet chart2 = Nothing 作者：王春天 2013.11.14 地址：

/spring_wang/p/