【Access小品】列表框获取Excel表标签实例

todaynew

1、在Vb设计视图中增加引用：
Microsoft Office 11.0 Object Library
Microsoft Excel 11.0 Object Library

2、写三个自定义函数如下：
Function GetFile() As String
'功能说明:打开文件夹，返回文件名。
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
    .AllowMultiSelect = True
    .Show
End With
GetFile = dlgOpen.SelectedItems(1)
Set dlgOpen = Nothing
End Function

Function OpenE(Ename As String) As Workbook
'功能说明:打开Excle文件。
'参数：Ename：目标文件名
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Set xlBook = xlApp.Workbooks.Open(Ename)
xlApp.Application.Visible = False
xlBook.Application.Sheets(1).Select
Set OpenE = xlBook
End Function

Function GetShtname(MyWorkbook As Workbook) As String
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim str As String
Set xlBook = MyWorkbook
For i = 1 To xlBook.Sheets.Count
    str = str & xlBook.Sheets(i).Name & ";"
Next
GetShtname = str
xlBook.Close
xlApp.Quit
End Function


3、调用三个函数获得列表框数据源：
Private Sub 标签_DblClick(Cancel As Integer)
Dim str As String
str = GetShtname(OpenE(GetFile))
Me.标签.RowSourceType = "Value List"
Me.标签.RowSource = str
End Sub

t小宝

好帖要顶！

chaojianan

代码全部收藏了.

5988143

支持精品原創作~

todaynew

谢谢领导和同志能支持和鼓励

jay_0218

谢谢分享

goto2008

谢谢分享

yihesmxx

谢谢分享

ycxchen

支持精品原創作

dragonszr

下来学习!