VBA开发文档快速查询工具

环境:windows+wps2019+vba7.0

1.建立文件:新建xlsx文件,打开并另存为启用宏的工作簿(.xlsm)类型文件,命名为“查询工具",即最终工具文件为"查询工具.xlsm"。

2.创建自定义用户窗体:Alt+F11(或Fn+Alt+F11)打开VB编辑器(备注:默认WPS个人版是没有安装VBA插件的,需自行下载安装,若未安装,则无法做VBA开发),右键对象窗体下工作簿对象,插入一个”用户窗体“。双击对象“ThisWorkbook",进入代码编辑区,键入:

Private Sub workbook_open()
    ThisWorkbook.Windows(1).Visible = False
    UserForm1.Show
End Sub

备注:以上代码执行后会只显示窗体,但不会显示工作簿,不过工作簿仍是在打开状态,只有在关闭wps表格程序后方可再次打开并使用该工作簿。为方便编译,我们先写成如下(否则需要再打开其它工作簿,才可以进入代码编辑;若只是注释掉第二行代码,则容易出现自动化错误),即:

Private Sub workbook_open()
    ThisWorkbook.Windows(1).Visible = False
    UserForm1.Show
    ThisWorkbook.Windows(1).Visible = True
End Sub

3.设计用户窗体:打开”查询工具.xlsm",使用alt+f11打开编辑器,双击对象窗体,插入待实现功能的控件,如下:

 

4.在工作簿中建立文件夹与路径列表【源文件路径表】,以实现对特定文件夹下文件的快速打开:

 

 

 这里是选择在Sheet1表中建立文件查询列表,如上:

5.控件功能代码实现:双击相应控件,并键入如下代码:

Public sf_path As String
Private Sub ComboBox5_Change()

    Dim sf_name_c As New Collection, temp_name As String
    With ThisWorkbook.Worksheets("源文件路径表")
        sf_path = .Cells(.Cells.Find(what:=ComboBox5.Value, LookIn:=xlValues, lookat:=xlWhole).Row, 3)
    End With
    
    temp_name = VBA.Dir(sf_path + "*.xls*") '返回对应路径下第一个符合*.xls*的文件名称
    
    Do While Len(temp_name) <> 0 'Dir函数会按照指定的顺序依次访问文件夹下的文件,全部访问玩后,返回空值
        sf_name_c.Add (temp_name)
        temp_name = VBA.Dir
    Loop
    
    Dim sf_name_arr() As String
    ReDim sf_name_arr(1 To sf_name_c.Count)
    For i = 1 To sf_name_c.Count
        sf_name_arr(i) = sf_name_c.Item(i)
    Next i
    
    ComboBox6.List = sf_name_arr
    ComboBox6.Value = sf_name_arr(UBound(sf_name_arr)) '设置默认显示最后一个文件名
    
End Sub

Private Sub ComboBox6_Change()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        '-----打开工作簿
    Application.Workbooks.Open Filename:=sf_path + ComboBox6.Value, UpdateLinks:=False
    n = ActiveWorkbook.Sheets.Count 'n代表工作簿中的工作表的个数
    Dim wt_name_arr() As String
    
    ReDim wt_name_arr(1 To n)
    For i = 1 To n
        wt_name_arr(i) = ActiveWorkbook.Sheets(i).Name
    Next i
    
    ComboBox7.List = wt_name_arr
    ComboBox7.Value = wt_name_arr(1) '设置默认第一个工作表标签名
    ActiveWorkbook.Close savechanges:=False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

Private Sub CommandButton1_Click()
    On Error Resume Next
    '根据工作簿名称判断工作簿是否已经打开
    For Each wk In Application.Workbooks
        If wk.Name = ComboBox6.Value Then Application.Workbooks(ComboBox6.Value).Worksheets(ComboBox7.Value).Activate: Exit Sub
    Next
    
    Application.Workbooks.Open Filename:=sf_path + ComboBox6.Value, UpdateLinks:=False
    ActiveWorkbook.Worksheets(ComboBox7.Value).Activate
End Sub

Private Sub UserForm_Initialize()
    
    Dim sf_arr As Variant, rowend As Integer
    With Application.ThisWorkbook.Worksheets("源文件路径表")
    
        rowend = .Cells(.Rows.Count, 2).End(xlUp).Row
        sf_arr = .Cells.Range(.Cells(2, 2), .Cells(rowend, 2)).Value
    End With

    ComboBox5.List = sf_arr
    
End Sub

 保存即可。可实现【源文件路径表】中已设定的文件夹下Excel文件的快速查找,然后打开,其中最新的文件可直接打开。

posted @ 2020-06-15 15:35  heacool  阅读(799)  评论(0编辑  收藏  举报