在Word vba宏中添加进程指示器

Question

我在Word 中创建了一个 Vba脚本，用于比较所选文件夹中相同文档的多个版本。该脚本允许创建包含结果的新报告。

Private Sub SummaryReportButton_Click()
    Dim objDocA As Word.Document
    Dim objDocB As Word.Document
    Dim objDocC As Word.Document

    Dim objFSO As Scripting.FileSystemObject
    Dim objFolderA As Scripting.Folder
    Dim objFolderB As Scripting.Folder
    Dim objFolderC As Scripting.Folder

    Dim colFilesA As Scripting.Files
    Dim objFileA As Scripting.File

    Dim i As Integer
    Dim j As Integer

    Set objFSO = New FileSystemObject
    Set objFolderA = objFSO.GetFolder(ChooseFolder("Choose the folder with the original documents", ThisDocument.Path))
    Set objFolderB = objFSO.GetFolder(ChooseFolder("Choose the folder with revised documents", ThisDocument.Path))
    Set objFolderC = objFSO.GetFolder(ChooseFolder("Choose the folder for the comparisons documents", ThisDocument.Path))

    Set colFilesA = objFolderA.Files

    For Each objFileA In colFilesA
    If objFileA.Name Like "*.docx" Then
        Set objDocA = Documents.Open(objFolderA.Path & "\" & objFileA.Name)
        Set objDocB = Documents.Open(objFolderB.Path & "\" & objFileA.Name)
        Set objDocC = Application.CompareDocuments( _
            OriginalDocument:=objDocA, _
            RevisedDocument:=objDocB, _
            Destination:=wdCompareDestinationNew)
        objDocA.Close
        objDocB.Close
        On Error Resume Next
        Kill objFolderC.Path & "\" & objFileA.Name
        On Error GoTo 0
        objDocC.SaveAs FileName:=objFolderC.Path & "\" & objFileA.Name
        objDocC.Close SaveChanges:=False
    End If
    Next objFileA

End Sub

Function ChooseFolder(strTitle As String, strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String


    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = strTitle
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
End Function

我想通过在流程上显示一个指标来改进我的脚本，直到它完成为止。

我想用一个消息框：

Msgbox  "Processing " & i & " of " &  colFilesA.Count

但每次都需要点击它......这不是最好的解决方案......

你能帮我做一个最好的解决方案吗？

先谢谢你的帮助，

此致

Answer 1

尝试使用Application.StatusBar。您可以通过以下方式初始化和更改状态栏中的文本：

Application.StatusBar = "Processing " & i & " of " &  colFilesA.Count

并在宏的末尾请添加以下行以清除StatusBar消息：

Application.Statusbar = false