VBA, Zoeken, niet gevonden dan elders verder in de code.

[Withaar]

Ik heb een VBA macro die in een Word document op zoek gaat naar een bepaalde string.
Zeg *@* als deze gevonden wordt moet de tekst geselecteerd worden en dan vervangen worden door een ander tekst.
Dit gaat allemaal prima.

Probleem is dat al de string (*@*) niet gevonden wordt, cq niet voorkomt in de tekst, de cursor boven aan te bladzijde blijft staan en de tekst daar ingevoegd wordt, dat is niet de bedoeling.

Niet gevonden zou moeten moeten resulteren in een sprong naar de volgende zoek opdracht. Dus verder bij ' Ondertekenings blok herkenbaar aan *@@*
Iets als, If Find = True then...

Code die ik nu gebruik;

Sub TB()
    Dim d As Single
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "*@*"
        .Replacement.Text = ""
    End With
Selection.Find.Execute
    Dim myrange As Range
    Set myrange = ActiveDocument.Range
Dim ref As Single
Dim reftxt As String
'lees de veldname
For ref = 1 To ActiveDocument.Fields.Count
    If Mid(ActiveDocument.Fields(ref).Code.Text, 14, 14) = "Cursustypecode" Then
           reftxt = ActiveDocument.Fields(ref).Result.Text
           Selection.InsertFile FileName:="V:\sjablonen\Tekstblokken\" & reftxt & ".doc"
    d = 1
    End If
Next
If d <> 1 Then
    For ref = 1 To ActiveDocument.Fields.Count
        If Mid(ActiveDocument.Fields(ref).Code.Text, 14, 15) = "cursus_codering" Then
           reftxt = ActiveDocument.Fields(ref).Result.Text
           Selection.InsertFile FileName:="V:\sjablonen\Tekstblokken\" & reftxt & ".doc"
        End If
    Next
   End If
'
' Ondertekenings blok herkenbaar aan *@@*
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "*@@*"
        .Replacement.Text = ""
    End With
Selection.Find.Execute
'lees de veldname
For ref = 1 To ActiveDocument.Fields.Count
    If Mid(ActiveDocument.Fields(ref).Code.Text, 14, 7) = "user_id" Then
           reftxt = ActiveDocument.Fields(ref).Result.Text
           Selection.InsertFile FileName:="V:\sjablonen\Tekstblokken\" & reftxt & ".doc"
    End If
Next
End Sub

 

[jepewe]

Heer Withaar,
Zou het zo kunnen zijn, dat waar er alreeds in de eerste regels van de macro gesproken wordt over een "selection", er daardoor in de macro het verkeerde idee wordt gewekt dat er al iets geselecteerd is en bij niets vinden deze niet bestaande "selectie" alsnog wordt veranderd.
Groet
Joop

 

[Withaar]

Dat is volgens mij niet het probleem.

Er wordt een string gezocht *@*, deze wordt (uiteraard als aanwezig) geselecteerd.

Dan komt min of meer los daarvan de import van het tekstblok. De *@* diend eigelijk alleen maar als 'anker' in te hoofdtekst.

Dit min of meer los er van is het probleem, als er niet geseleteerd is wordt het invoegen gewoon gedaan op de plek waar de cursor op dat moment staat. Bij een net geopend document is dat links bovenaan.

Ben nu aan het kijken naar een word counter, gewoon tellen hoevaal *@* voor komt, 0 dan False, 1 dan True...

 

[Withaar]

Kan vermoedelijk fraaier, maar dit werkt;

Dim lCount As Long
Dim rDcm As Range
Dim oWrd As Range
Set rDcm = ActiveDocument.Range
For Each oWrd In rDcm.Words
If oWrd = "*@*" Then
lClount = lCount + 1
End If
Msxbox (lCount)
Next