Как работать с выбором

Question

Я пытаюсь преобразовать отлично рабочий макрос в гиперссылку с activedoccument.range to selection.range.

код

With Selection.Range 
    With .Find 
    .ClearFormatting 
    .Replacement.ClearFormatting 
    .Text = "String String1" 
    .Replacement.Text = "" 
    .Forward = True 
    .Wrap = wdFindStop 
    .Format = False 
    .MatchWildcards = True 
    .Execute 
    End With 
    Do While .Find.Found 
    strtxt = Split(.Text, " ")(1) 
    strtxt = Right(strtxt, 2) & "/" & Left(strtxt, 4) & "/" & Mid(strtxt, 8, 2) & "/" & Mid(strtxt, 5, 3) 
    .Hyperlinks.Add Anchor:=.Duplicate, Address:="Address" & strtxt & "/0.pdf", TextToDisplay:=.Text 
    .End = .Fields(1).Result.End 
    .Collapse wdCollapseEnd 
    .Find.Execute 
    Loop 
End With 

Как правильно свернуть, чтобы сделать эту работу. В настоящее время это гиперссылки все в doccument вместо выбора.

Answer 1

Насколько я могу судить, проблема в том, что конец найденного диапазона должен быть увеличен на 1 при вставке гиперссылки. Но я считаю, что вам также нужно проверить, что вы не прошли первоначальный вариант Selection.Range, поэтому вам нужен дополнительный тест.

Это выглядело ОК в таблицах, но (а) Я тестирую в Mac Word 2011, что может быть другим, и (б), если вы действительно выбираете столбец или не связанные диапазоны, вам придется работать намного сложнее внести изменения только в выборку (из-за известной недостаточной поддержки таких выборов).

Sub fandr() 
Const strText As String = "String String1" 
Dim dr As Word.Range 
Dim sr As Word.Range 
Set sr = Selection.Range 
'Debug.Print sr.Start, sr.End 
Set dr = sr.Duplicate 
' Try to deal with the problem where Find fails to find 
' the Find text if it is exactly the same as the selection 
sr.Collapse wdCollapseStart 
With sr.Find 
    .ClearFormatting 
    .Replacement.ClearFormatting 
    .Text = strText 
    .Replacement.Text = "" 
    .Forward = True 
    .Wrap = wdFindStop 
    .Format = False 
    .MatchWildcards = True 
    Do While .Execute(Replace:=False) 
    If sr.InRange(dr) Then 
     'Debug.Print sr.Start, sr.End, dr.Start, dr.End 
     strtxt = Split(.Text, " ")(1) 
     strtxt = Right(strtxt, 2) & "/" & Left(strtxt, 4) & "/" & Mid(strtxt, 8, 2) & "/" & Mid(strtxt, 5, 3) 
     sr.Hyperlinks.Add Anchor:=sr, Address:="Address" & strtxt & "/0.pdf", TextToDisplay:=.Text 
     sr.Collapse wdCollapseEnd 
     sr.End = sr.End + 1 
     sr.Start = sr.End 
     'Debug.Print sr.Start, sr.End, dr.Start, dr.End 
    Else 
     Exit Do 
    End If 
    Loop 
End With 
Set sr = Nothing 
Set dr = Nothing 
End Sub 

Answer 2

Так что я изменил несколько вещей. Каким-то образом Range становился испорченным после добавления HyperLink. поэтому я просто сбросил SearchRange после добавления гиперссылки.

Это будет отлично работать, если выбор не является частью Table. Я добавил несколько проверок, чтобы увидеть, находится ли он в стороне от таблицы, но теперь нет времени для завершения смены ячейки.

Sub SearchTextAddHyperLink() 

     Dim SearchRange As Range 
     Dim OriginalRange As Range 
     Dim FoundRange As Range 
     Set SearchRange = Selection.Range 
     Set OriginalRange = Selection.Range 

     Dim strtxt As String 
     Dim SearchText As String 
     Dim CellPosition As String 
     SearchText = "String String1" 

     With SearchRange 
      With .Find 
      .ClearFormatting 
      .Replacement.ClearFormatting 
      .Text = SearchText 
      .Replacement.Text = "" 
      .Forward = True 
      .Wrap = wdFindStop 
      .Format = False 
      .MatchWildcards = True 

      End With 

      Do While .Find.Execute 
      '.Select 
       If .Find.Found = True Then 

        Set FoundRange = SearchRange 
        FoundRange.Select 
        strtxt = Split(.Text, " ")(1) 
        strtxt = Right(strtxt, 2) & "/" & Left(strtxt, 4) & "/" & Mid(strtxt, 8, 2) & "/" & Mid(strtxt, 5, 3) 
        .Hyperlinks.Add Anchor:=.Duplicate, Address:="Address" & strtxt & "/0.pdf", TextToDisplay:=.Text 


         If Not FoundRange.Information(wdWithInTable) Then 
          'Resetting the SearchRange for outside a table 
          'For some reason the Hyperlink messes up the Range 
          'Len(SearchText) + 1 just caters for the changing the Search Text 
          'and adding an additional character to move passed the hyperlink 
          SearchRange.Start = FoundRange.End + Len(SearchText) + 1 
          SearchRange.End = OriginalRange.End 
        Else 
          'Resetting the SearchRange for inside a table 
          'Need to then be clever with determinign which cell you are in and then moving to the next cell 
          'SearchRange.Start = FoundRange.End 'Len(SearchText) + 1 
          'SearchRange.End = OriginalRange.End 

        End If 
       End If 
       'Just to check the SearchRange 
       SearchRange.Select 
      Loop 

     End With 

End Sub 

ПРИМЕЧАНИЕ: Кроме того, не забудьте также Dim все ваши переменные идти вперед.