在单词vba宏中添加过程指示器



i在Word 中创建了A 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

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

您能帮我做一个最好的解决方案吗?

事先感谢您的帮助,

问候

尝试使用Application.StatusBar。您可以以这种方式初始化和更改状态栏中的文本:

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

,在宏的末尾,请添加以下行以清洁状态栏消息:

Application.Statusbar = false

最新更新