规划模型运行工具 -- VBA Scheduled Run

Mengkelyu

因为最近常常要跑很多VBA模型，所以自己写了一个工具，来让一个模型运行完之后自动运行下个要跑的模型。

目前还在开发阶段，所以如果有Bug欢迎提出！

界面大概如下，目前允许最多Schedule三个模型。

Mengkelyu

先看看怎么运用：
首先要打开工具所在的Excel，找到选项：

打开信任中心

宏设置这里勾选"Trust Access to the VBA project object model"

Mengkelyu

然后打开VBA编辑器，

工具->Reference

勾选这个蓝色的Microsoft Visual Basic for Applications Extensibility xx.xx

Mengkelyu

打开Excel，点击这个美丽的按钮

弹出这个界面

点击Choose File，选择要运行的宏所在的工作簿

Macro那里会自动弹出这个工作簿下的所有宏，选择你想要运行的，然后点击Run as scheduled，这些宏就会一个一个自动运行啦

Mengkelyu

ScheduledRun V0.9.zip
宏我放在这里了。

Mengkelyu

这里大概讲一下制作思路：
首先按照这个样子制作一个用户窗体

操作的话就是利用VBA自带的ToolBox点点点

要熟悉不同的工具的名称，我写在这里供大家参考
Screenshot 2022-02-19 160033.png

Mengkelyu

可以在Property 窗口改每一个控件的名字（Name）

需要把这个Name和下面的Caption区别看，Name是我们写代码的时候引用到这个控件需要用到的名字，Caption是展现给用户的名称。

然后我们定义一些事件，

双击Choose file对应的控件，进入代码界面（代码看不全可以左右上下滑动）

‘ 这里的File1是我给第一个Choose File那个控件起的名字
Private Sub File1_Click()
’ 这里的TextBox1是File Name后面的那个TextBox的名字(Name)，我把用户选择的文件路径给了TextBox1
TextBox1.Value = FileOpenDialogBox
‘ 这里的listbox_fill是用来填充所有宏名称的代码
Call listbox_fill1(ListBox1)
End Sub
’ 这个是我在网上找到的打开某一个工作簿的代码：
Function FileOpenDialogBox()

'Display a Dialog Box that allows to select a single file.
'The path for the file picked will be stored in fullpath variable
  With Application.FileDialog(msoFileDialogFilePicker)
        'Makes sure the user can select only one file
        .AllowMultiSelect = False
        'Filter to just the following types of files to narrow down selection options
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        'Show the dialog box
        .Show
        
        'Store in fullpath variable
        FileOpenDialogBox = .SelectedItems.Item(1)
    End With

End Function

‘ 找到工作簿里面所有宏的名称，这个也是网上的代码，我基本没有改
Private Sub listbox_fill1(lb)
 ' Declare variables to access the Excel workbook.
    Dim objXLApp As Excel.Application
    Dim objXLWorkbooks As Excel.Workbooks
    Dim objXLABC As Excel.Workbook

' Declare variables to access the macros in the workbook.
    Dim objProject As VBIDE.VBProject
    Dim objComponent As VBIDE.VBComponent
    Dim objCode As VBIDE.CodeModule

' Declare other miscellaneous variables.
    Dim iLine As Integer
    Dim sProcName As String
    Dim pk As vbext_ProcKind

' Open Excel, and open the workbook.
    Set objXLApp = New Excel.Application
    Set objXLWorkbooks = objXLApp.Workbooks
    Set objXLABC = objXLWorkbooks.Open(TextBox1.Value)

' Empty the list box.
    lb.Clear

' Get the project details in the workbook.
    Set objProject = objXLABC.VBProject

' Iterate through each component in the project.
    For Each objComponent In objProject.VBComponents

' Find the code module for the project.
        Set objCode = objComponent.CodeModule

' Scan through the code module, looking for procedures.
        iLine = 1
        Do While iLine < objCode.CountOfLines
            sProcName = objCode.ProcOfLine(iLine, pk)
            If sProcName <> "" Then
                ' Found a procedure. Display its details, and then skip
                ' to the end of the procedure.
                lb.AddItem sProcName 'objComponent.Name & vbTab &
                iLine = iLine + objCode.ProcCountLines(sProcName, pk)
            Else
                ' This line has no procedure, so go to the next line.
                iLine = iLine + 1
            End If
        Loop
        Set objCode = Nothing
        Set objComponent = Nothing
    Next

Set objProject = Nothing

' Clean up and exit.
    objXLABC.Close
    objXLApp.Quit
End Sub

Mengkelyu

2.点击Run as Scheduled 控件发生的事件（代码看不全可以左右上下滑动）

'这个控件我起的名字是Run
Private Sub Run_Click()
‘Error handling
On Error Resume Next
Dim wb As Workbook
Application.ScreenUpdating = False

'如果第一个Listbox不是空值
If ListBox1.Value <> "" Then
  '在Excel屏幕左下方告诉用户第一个宏正在跑
    Application.StatusBar = "Your first task is running"
   '跑这个宏
    Application.Run "'" + TextBox1.Value + "'!" + ListBox1.Value
    Set wb = Workbooks.Open(TextBox1.Value)
    '关掉打开的工作簿
    wb.Close SaveChanges:=False
   ’第二第三个task同理
    If ListBox2.Value <> "" Then
        Application.StatusBar = "Your second task is running"
        Application.Run "'" + TextBox2.Value + "'!" + ListBox2.Value
        Set wb = Workbooks.Open(TextBox2.Value)
        wb.Close SaveChanges:=False
    End If
    If ListBox3.Value <> "" Then
        Application.StatusBar = "Your third task is running"
        Application.Run "'" + TextBox3.Value + "'!" + ListBox3.Value
        Set wb = Workbooks.Open(TextBox3.Value)
        wb.Close SaveChanges:=False
    End If
Else
    MsgBox "Please input the macro you want to schedule ;D"
End If

Application.ScreenUpdating = True

If Err.Description = "" Then
    MsgBox "Successfully run"
Else
    MsgBox "Please note the following error message in running your code: " + Err.Description
End If

End Sub