0

好吧，这是我第二次尝试编写代码，也是我被分配从事的第二个 VBA 宏项目。在过去的一个半星期里，我一直在努力学习 VBA 作为我的第一门编码语言，所以我为愚蠢的错误道歉。话虽如此，直奔业务。这是我为 word 文档宏汇总的内容：

Sub MacroToUpdateWordDocs()
    'the following code gets and sets a open file command bar for word documents
    Dim Filter, Caption, SelectedFile As String
    Dim Finalrow As String
    Dim FinalrowName As String
    Filter = "xlsx Files (*.xlsx),*.xlsx"
    Caption = "Please Select A .xlsx File, " & TheUser
    SelectedFile = Application.GetOpenFilename(Filter, , Caption)
    'check if value is blank if it is exit
    Finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    FinalrowName = Finalrow + 1
    If (Trim(SelectedFile) = "") Then
        Exit Sub
    Else
        'setting up the inital word application object
        Set auditmaster = CreateObject("excel.sheet")
        'opening the document that is defined in the open file dialog
        auditmaster.Application.Workbooks.Open (SelectedFile)
        'ability to change wether it needs to burn cycles updating the UI
        auditmaster.Visible = False
        'declare excel sheet
        Dim wdoc As Document
        'set active sheet
        Set wdoc = Application.ActiveDocument
        Dim i As Integer
        Dim u As Integer
        Dim ColumnAOldAddy As String
        Dim ColumnCNewAddy As String
        u = 1
        i = 1
        'MsgBox (wordapp.ActiveDocument.Hyperlinks.Count)
        'Sets up a loop to go through the Excel Audit file rows.
        For i = 1 To auditmaster.ActiveSheet.Rows.Count
            'Identifies ColumnAOldAddy and ColumnCNewAddy as columns A and C for each row i.  Column A is the current hyperlink.address, C is the updated one.
            ColumnAOldAddy = auditmaster.Cells(i, 1)
            ColumnCNewAddy = auditmaster.Cells(i, 3)
            'If C has a new hyperlink in it, then scan the hyperlinks in wdoc for a match to A, and replace it with C
            If ColumnCNewAddy = Not Nothing Then
                For u = 1 To doc.Hyperlinks.Count
                    'If the hyperlink matches.
                    If doc.Hyperlinks(u).Address = ColumnAOldAddy Then
                        'Change the links address.
                        doc.Hyperlinks(u).Address = ColumnCNewAddy
                    End If
                'check the next hyperlink in wdoc
                Next
            End If
            'makes sure the macro doesn't run on into infinity.
            If i = Finalrow + 1 Then GoTo Donenow
        'Cycles to the next row in the auditmaster workbook.
        Next
Donenow:
        'Now that we've gone through the auditmaster file, we close it.
        auditmaster.ActiveSheet.Close SaveChanges:=wdDoNotSaveChanges
        auditmaster.Quit SaveChanges:=wdDoNotSaveChanges
        Set auditmaster = Nothing
    End If
End Sub

因此，此代码假设采用由我的第一个宏创建的超链接审核文件（最后一个错误已修复并且功能非常好，感谢 Stack Overflow 社区！）。对于在目标 .docx 中找到的每个超链接，审计文件有 3 列和一行：A = 超链接地址，B = 超链接显示文本，C = 新超链接地址

当代码从要更新的 .docx 文件运行时，它允许用户选择审计文件。从那里，它逐行检查更新的超链接地址是否已由旧的审核地址/显示名称写入 C 列，然后在 .docx 文件中搜索旧的超链接地址并将其替换为新的超链接地址. 此时，它完成了对文档的搜索，然后移动到审计 Excel 文件中的下一行。

我的问题是大部分代码都是从excel宏中复制/粘贴的。我一直在弄清楚如何将该代码翻译成适当地识别/引用单词/excel文档的东西。我希望有更多经验的人可以看看这个宏，让我知道我在哪里完全搞砸了。目前，它一直给我“找不到方法或数据成员”错误，主要是关于我尝试引用审计 Excel 文件的位置。我很确定这是一个相对简单的解决方法，但我没有词汇来弄清楚如何用谷歌搜索答案！

4

1 回答 1

1

编译正常，但未经测试：

Sub MacroToUpdateWordDocs()

    Dim Filter, Caption, SelectedFile As String
    Dim Finalrow As String
    Dim appXL As Object
    Dim oWB As Object
    Dim oSht As Object
    Dim wdoc As Document
    Dim ColumnAOldAddy As String
    Dim ColumnCNewAddy As String
    Dim i As Long
    Dim h As Word.Hyperlink
    Dim TheUser As String

    Filter = "xlsx Files (*.xlsx),*.xlsx"
    Caption = "Please Select A .xlsx File, " & TheUser

    Set appXL = CreateObject("excel.application")
    appXL.Visible = True
    SelectedFile = appXL.GetOpenFilename(Filter, , Caption)
    appXL.Visible = False

    If Trim(SelectedFile) = "" Then
        appXL.Quit
        Exit Sub
    Else
        Set oWB = appXL.Workbooks.Open(SelectedFile)
        Set oSht = oWB.worksheets(1)
        Finalrow = oSht.Cells(oSht.Rows.Count, 1).End(-4162).Row '-4162=xlUp
    End If

    Set wdoc = Application.ActiveDocument

    For i = 1 To Finalrow

        ColumnAOldAddy = oSht.Cells(i, 1).Value
        ColumnCNewAddy = oSht.Cells(i, 3).Value

        If ColumnCNewAddy <> ColumnAOldAddy Then
            For Each h In wdoc.Hyperlinks
                If h.Address = ColumnAOldAddy Then
                    h.Address = ColumnCNewAddy
                End If
            Next h
        End If

    Next i

    oWB.Close False
    appXL.Quit

End Sub
于 2012-08-28T22:47:12.837 回答