Question

好吧，这是我对代码的第二次尝试，以及我被分配到的第二个VBA宏项目。在过去一周半的时间里，我一直在努力学习VBA作为我的第一个编码语言，所以我为愚蠢的错误道歉。那说，直奔商家。这是我为单词文档宏放在一起的内容：

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社区，最后的错误修复并运行得非常好！）。审计文件有3列，并且在目标.docx中找到的每个超链接都有一行：A =超链接地址，B =超链接displaytext，C =新的超链接地址

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

我的问题是，大部分代码都是从excel宏中复制/粘贴代码。我一直在考虑如何将代码转换为适当地标识/引用word / excel文档的内容。我希望有更多经验的人可以看看这个宏，让我知道我已经完全错误的地方。它一直在给我提供“找不到方法或数据成员”的错误，主要是关于我尝试引用审计excel文件的地方。我很确定这是一个相对简单的修复，但我没有词汇来弄清楚如何谷歌答案！

Answer 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

在VBA中翻译文件关联

1 个答案: