Question

我是vba的业余爱好者。我的宏（下面）从所选文本创建一个超链接，但新的超链接是黑色，而我使用MS Word的菜单创建的超链接是蓝色。我希望我的宏也能创建蓝色的超链接。正如您在我的宏（下图）中看到的那样，我无法将超链接变为蓝色。任何建议都会非常感激。

        Marc

以下是宏：

Sub subHyprlinkSrch4PdfFiles_aaa()
'
' subHyprlinkSrch4PdfFiles_aaa Macro
'
'
    Dim strTextToDisplay As String
    Dim rngSelection As RAnge

    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.MoveLeft Unit:=wdCharacter, Count:=5
    Selection.MoveLeft Unit:=wdCharacter, Count:=9, Extend:=wdExtend
    Set rngSelection = ActiveDocument.Selection.RAnge

    Application.Selection.Font.ColorIndex = wdBlue
    strTextToDisplay = Application.Selection.Text
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.RAnge, Address:="" _
        , SubAddress:="", ScreenTip:="", TextToDisplay:=strTextToDisplay
    Application.Selection.Style = wdStyleHyperlink
    Application.Selection.Font.ColorIndex = wdBlue
    With rngSelection
        .Font.ColorIndex = wdBlue
    End With


End Sub 'subHyprlinkSrch4PdfFiles_aaa()

这是我使用解决方案用户Don Jewett于2016年11月2日（下方）给我的解决方案：

Sub subHyperlinkSelectedTextaaa() 'Hyperlink  to a file whatever text you selected.
    'Hyperlink  to a file whatever text you selected.

    ' http://www.wiseowl.co.uk/blog/s209/type-filedialog.htm

    Dim Sel01 As Selection
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim iFileChosen As Integer
    Dim strFileFullname As String
    Dim Txt2Display As String


    Set Sel01 = Application.Selection

    If Sel01.Type <> wdSelectionIP Then ' i.e., if the selection is valid, i.e., characters are selected
        Txt2Display = Sel01.Text
        'MsgBox Txt2Display
    Else
        MsgBox "No characters were selected validly; so this macro will terminate now."
        Exit Sub
    End If 'If Sel01.Type <> wdSelectionIP Then ' i.e., if the selection is valid, i.e., characters are selected



    ' Open FileDialog "fd" and select a file
    iFileChosen = fd.Show
        If iFileChosen <> -1 Then
            'You didn't choose anything (clicked on CANCEL)
            MsgBox "You chose cancel, or something prevented the file-selection-dialog from operating property."
        Else
            strFileFullname = CStr(fd.SelectedItems(1))
            'MsgBox strFileFullname
        End If


    ' http://stackoverflow.com/questions/40388765/color-of-new-ms-word-hyperlink-is-black-and-i-want-it-to-be-blue
    With Application.Selection
        .Font.ColorIndex = wdBlue
        'ActiveDocument.Hyperlinks.Add Selection.Range, .Text, "", "", .Text
        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
           strFileFullname, SubAddress:="", ScreenTip:="", TextToDisplay:=Txt2Display
        .Style = wdStyleHyperlink
    End With


End Sub 'subHyperlinkSelectedTextaaa()

Answer 1

如果要使用所选文本作为链接和文本创建超链接，这应该可以正常工作：

Sub subHyprlinkSrch4PdfFiles_aaa()

    With Application.Selection
        .Font.ColorIndex = wdBlue
        ActiveDocument.Hyperlinks.Add Selection.Range, .Text, "", "", .Text
        .Style = wdStyleHyperlink
    End With

End Sub

新的MS Word超链接的颜色是黑色，我希望它是蓝色

1 个答案: