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文件的快速查找,然后打开,其中最新的文件可直接打开。