0

わかりました。これはコードの 2 回目の試みであり、私が担当するように割り当てられた 2 番目の VBA マクロ プロジェクトです。この 1 週間半、最初のコーディング言語として 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

したがって、このコードは、私の最初のマクロによって作成されたハイパーリンク監査ファイルを使用することになっています (スタック オーバーフロー コミュニティのおかげで、最後のバグは修正され、素晴らしく機能しています!)。監査ファイルには、ターゲット .docx で見つかったハイパーリンクごとに 3 つの列と行があります。A = ハイパーリンク アドレス、B = ハイパーリンク表示テキスト、C = 新しいハイパーリンク アドレス

更新する .docx ファイルからコードを実行すると、ユーザーは監査ファイルを選択できます。そこから行ごとに、更新されたハイパーリンク アドレスが古い監査済みアドレス/表示名によって C 列に書き込まれているかどうかを確認し、.docx ファイルで古いハイパーリンク アドレスを検索して、新しいハイパーリンク アドレスに置き換えます。 . その時点で、ドキュメントの検索が終了し、監査 Excel ファイルの次の行に移動します。

私の問題は、このコードの多くが Excel マクロのコードからコピー/貼り付けされていることです。そのコードを単語/Excelドキュメントを適切に識別/参照するものに変換する方法を考え出すのに、私はかなりの時間を費やしてきました。もっと経験のある人がこのマクロをのぞき見して、私が完全にバグったところを教えてくれることを願っています. 現在、主に監査Excelファイルを参照しようとしている場所に関連して、「メソッドまたはデータメンバーが見つかりません」というエラーが発生し続けています。これは比較的簡単に修正できると確信していますが、答えを Google で検索する方法を理解するための語彙がありません。

4

1 に答える 1

1

コンパイルはOKですが、テストされていません：

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 に答える