Lus zoek en vervang

[Kramer]

Hoi Iedereen.

ik heb een macro gemaakt die zoekt naar een bepaalde tekst deze hele regel kopiert en dan omzet naar een hyperlink.

Nu heb ik alleen het volgende probleem:
Het te zoeken tekst kan in een document 1 keer voorkomen maar ook 100 keer.

Nu heb ik wel een lus gemaakt. Maar als ik deze nu draai stopt de macro niet. Kan iemand mij helpen onderstaande code aan te passen:

Sub zoekENvervang

Dim Var As String

Do
   
    With Selection.Find
        .Text = "mysite://"
        .Forward = True
    End With
    Selection.Find.Execute

    Selection.HomeKey Unit:=wdLine
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.copy
    Var = Selection.Text
    
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=Var, SubAddress:="", _
    ScreenTip:="", TextToDisplay:="Hier"
       
Loop
end sub

Alvast bedankt

 

[snb]

Sub M_snb()
    Selection.HomeKey wdStory
    
    Do Until InStr(ActiveDocument.Content, "test") = 0
        Selection.Find.Execute "test"
        ActiveDocument.Hyperlinks.Add Selection.Range, "http://www.snb-vba.eu", , , "snb"
    Loop
End Sub

 

[Kramer]

??

Hij zet nu op bovenaan de pagina snbsnbsnb als link neer.

Misschien kan ik het duidelijker maken met wat ik bedoel als ik het document er bij doe.
De link is namelijk elke keer anders. Vandaar dat hij moet zoeken naar mysite:// en dan de hele regel moet selecteren.

Zie bijlage
Bekijk bijlage Daglijst.dot

 

[snb]

Sub M_snb()
    Selection.HomeKey wdStory
    
    For Each it In Filter(Split(Replace(ActiveDocument.Content, vbCr, " " & vbCr & " ")), "//")
        Selection.Find.Execute it
        ActiveDocument.Hyperlinks.Add Selection.Range, it, , , "snb"
    Next
End Sub

 

[Kramer]

Bedankt

:thumb:

Bedankt. Hij werkt perfect. Nu nog ontleden zodat ik hem zelf snap