0

現在、次のコードを使用して、アプリケーション内のすべてのリンクを更新しています。

Sub AddSources()
    Dim pubPage As Page
    Dim pubShape As Shape
    Dim hprlink As Hyperlink
    Dim origAddress() As String
    Dim exportFileName As String
    exportFileName = "TestResume"
    Dim linkSource As String
    linkSource = "TestSource2"

    For Each pubPage In ActiveDocument.Pages
        For Each pubShape In pubPage.Shapes
            If pubShape.Type = pbTextFrame Then
                For Each hprlink In pubShape.TextFrame.TextRange.Hyperlinks
                    If InStr(hprlink.Address, "http://bleaney.ca") > 0 Then
                        origAddress = Split(hprlink.Address, "?source=")
                        hprlink.Address = origAddress(0) + "?source=" + linkSource
                    End If
                Next hprlink
            End If
        Next pubShape
    Next pubPage
    ThisDocument.ExportAsFixedFormat pbFixedFormatTypePDF, "C:\" + exportFileName + ".pdf"
End Sub

問題は、リンクを更新すると、書式設定が失われることです。ハイパーリンクの書式を保持するにはどうすればよいですか? Copy メソッドと Pasteメソッドを調べてみましたが、本当に必要なのはPaste Specialで、Hyperlink オブジェクトの Range プロパティには存在しないようです。

4

1 に答える 1

0

次の行を追加して、色と下線をキャプチャし、アドレスの変更後に元に戻してみてください

Sub AddSources()
    Dim pubPage As Page
    Dim pubShape As Shape
    Dim hprlink As Hyperlink
    Dim origAddress() As String
    Dim exportFileName As String
      Dim undline AS Long
      Dim clr AS Long
    exportFileName = "TestResume"
    Dim linkSource As String
    linkSource = "TestSource2"

    For Each pubPage In ActiveDocument.Pages
        For Each pubShape In pubPage.Shapes
            If pubShape.Type = pbTextFrame Then
                For Each hprlink In pubShape.TextFrame.TextRange.Hyperlinks
                    If InStr(hprlink.Address, "http://bleaney.ca") > 0 Then
                        undline = hprlink.Range.Font.Underline
                        clr = hprlink.Range.Font.Color
                        origAddress = Split(hprlink.Address, "?source=")
                        hprlink.Address = origAddress(0) + "?source=" + linkSource
                        hprlink.Range.Font.Color = clr
                        hprlink.Range.Font.Underline = undline
                    End If
                Next hprlink
            End If
         Next pubShape
    Next pubPage
    ThisDocument.ExportAsFixedFormat pbFixedFormatTypePDF, "C:\" + exportFileName + ".pdf"
End Sub
于 2013-12-20T15:16:24.637 に答える