Add hyperlinks to specific font style

[syl3786]

Hi community,



Thank you for expert's assistance in my previous post (https://www.msofficeforums.com/word-...-sequence.html). I encounter another issue:

Speaker 1: Hello I am ABC

Speaker 2: Please sit down.

Speaker 1: OK, Speaker 2.

Speaker 2: Please introduce yourself in 1 minute.

Speaker 1: Noted Speaker 2. I am XXX, I graduated from XXX......

Different hyperlinks need to be added to "speaker 1" and "speaker 2". The following macro by gmayor can automatically add different hyperlinks to the same texts but in different sequence according to the selected excel file.

Option Explicit
Const strWB As String = "C:\Path\To\Hyperlinks.xlsx"
Const strSheet As String = "Sheet1"

Sub AddHyperlinks()
Dim oDoc As Document
Dim oRng As Range
Dim Arr() As Variant
Dim i As Long
Dim sName As String, sLink As String
    Set oDoc = ActiveDocument
    Arr = xlFillArray(strWB, strSheet)
    For i = 0 To UBound(Arr, 2)
        sName = Arr(0, i)
        sLink = Arr(1, i)
        Set oRng = oDoc.Range
        With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            Do While .Execute(findText:=sName)
                If oRng.Hyperlinks.Count = 0 Then
                    oRng.Hyperlinks.Add oRng, sLink, , , sName
                    Exit Do
                End If
            Loop
        End With
    Next i
lbl_Exit:
    Exit Sub
End Sub

Private Function xlFillArray(strWorkbook As String, _
                             strRange As String) As Variant
'Graham Mayor - http://www.gmayor.com - 24/09/2016
Dim RS As Object
Dim CN As Object
Dim iRows As Long

strRange = strRange & "$]"    'Use this to work with a named worksheet
    'strRange = strRange & "]" 'Use this to work with a named range
    Set CN = CreateObject("ADODB.Connection")

    'Set HDR=NO for no header row
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkbook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"""

    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strRange, CN, 2, 1

    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function

However, if "Speaker 2" mentioned in the contents, then the hyperlink would be added to that. Then the sequence will be incorrect. Can I add the following code to the private function or the main part of the code so that the macro can just add hyperlinks to the specified font style, such as "Times New Roman in Bold type"?

Many thanks for your help and kind attention to this matter.

[gmayor]

You just need to add the font settings in question to the main macro, immediately below .Replacement.ClearFormatting e.g.

.Replacement.ClearFormatting
.Font.Name = "Times New Roman"
.Font.Bold = True

[syl3786]

Originally Posted by gmayor

You just need to add the font settings in question to the main macro, immediately below .Replacement.ClearFormatting e.g.

.Replacement.ClearFormatting
.Font.Name = "Times New Roman"
.Font.Bold = True

Many thanks for your help!!!