Question

我正在尝试将完美工作的宏转换为带有activedoccument.range的超链接到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

如何正确折叠以使其工作。目前，它在文档中的所有超链接代替选择。

Answer 1

据我所知，问题基本上是当插入超链接时，找到的范围的结尾需要增加1。但是我相信你还必须检查你是否还没有超过最初的Selection.Range结束，所以你需要额外的测试。

这在桌子上似乎没问题，但是（a）我目前正在使用Mac Word 2011进行测试，这可能会有所不同，而且（b），如果你实际选择了一个列或不连续的范围，你将需要工作很多更难以仅在选择中进行更改（因为众所周知缺乏对此类选择的支持）。

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

所以我改变了一些事情。添加HyperLink后，Range以某种方式搞砸了。所以我只是在添加超链接后重置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所有变量。

如何使用选择

2 个答案: