Opgelost Zoeken & Vervangen

[Excelvbas01]

Ik heb een Excel bestand en een word bestand. Vanaf Excel zoek ik een woord in WORD en deze wordt vervangen door een ander tekst. Tot dusver gaat het goed. Wat ik zou willen is het volgende.
Soms bevindt de tekst waar ik naar zoek, helemaal onderaan in WORD document. Ik moet dan handmatig er naar toe scrollen.
Is het mogelijk om dit te automatiseren. Ik bedoel, als de tekst is gevonden, dat er automatisch gescrold wordt naar dat woord.

Ik heb gezocht en geprobeerd maar helaas.

Ik hoop hier het antwoord te vinden.

 

[AHulpje]

Zo positioneer je na je vervangactie de cursor direct na de eerste vervangen tekst:

   wordApp.Selection.Find.Execute FindText:="Zoeken en vervangen"
   wordApp.Selection.Move Unit:=12, Count:=1

 

[snb]

Vermijd enige 'selection'

activedocument.content.find.execute

bevat parameters voor te vervangen tekst (en zo vaak je maar wil)

 

[Excelvbas01]

Top, het werkt zoals ik wilde.

Beiden bedankt.

 

[Excelvbas01]

Ik heb te vroeg gejuicht.
Als ik deze code

  wordApp.Selection.Find.Execute FindText:="Zoeken en vervangen"
   wordApp.Selection.Move Unit:=12, Count:=1

overzet naar een ander bestand dan krijg ik foutmelding.

In het bestand wat ik eerder heb geüpload werkt het prima. Maar zodra ik de code in ander bestand overzet dan krijg ik een foutmelding.

Ik denk dat dit te maken heeft met wordApp maar weet dit niet zeker.

Hopelijk heeft iemand hier een oplossing voor.

 

[AHulpje]

Plaats je code eens hier.

 

[Excelvbas01]

Sub SearchReplace()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim myStoryRange As Object
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True

    Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\Templatetst.docx")
    
    For Each myStoryRange In WordDoc.StoryRanges
        With myStoryRange.Find
            .Text = "Dit is een Test"
            .Replacement.Text = "Zoeken en vervangen"
            .Execute Replace:=wdReplaceAll
        End With
         WordApp.Selection.Find.Execute FindText:="Zoeken en vervangen"
         WordApp.Selection.Move Unit:=12, Count:=1
    Next myStoryRange
End Sub

 

[AHulpje]

Je hebt verzuimd wdReplaceAll een waarde te geven.

 

[Excelvbas01]

Helemaal niet gezien, Dank je.
Mag ik je een ding vragen?
Het document wordt elke keer geopend, is niet de bedoeling.
Als het document al open is, moet daar gezocht worden en niet opnieuw openen.
bedankt alvast.

 

[snb]

Deze regel volstaat; vervangt iedere x in het document door een "y"

Sub M_snb()
   Getobject(ThisWorkbook.Path & "\Templatetst.docx").content.find.execute "x",,,,,,,,,"y",2
End Sub

 

[Excelvbas01]

snb bedank voor het meedenken.
Ik wil graag de code die ik hier heb gepost gebruiken. Hij werk nog niet perfect.....
Ik heb stukje code toegevoegd om te voorkomen dat het document elke keer opent als ik op de knop druk. Het probleem is nu dat de code waar het omgaat niet meer werkt.

Geeft fout bij

For Each myStoryRange In WordDoc.StoryRanges

Ik kom er niet achter waarom.

Private Sub CommandButton1_Click()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim myStoryRange As Object
    Dim CreatWordInstance As Boolean
    
    If WordApp Is Nothing Then
         Set WordApp = CreateObject("Word.Application")
         CreatWordInstance = True
      Else
        Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\Templatetst.docx")
    
    For Each myStoryRange In WordDoc.StoryRanges
        With myStoryRange.Find
            .Text = "Dit is een Test"
            .Replacement.Text = "Zoeken en vervangen"
            .Execute Replace:=wdReplaceAll
        End With
         WordApp.Selection.Find.Execute FindText:="Zoeken en vervangen"
         'of activedocument.content.find.execute
         WordApp.Selection.Move Unit:=12, Count:=1
    Next myStoryRange
    End If
End Sub

 

[AHulpje]

Als je netjes inspringt zie je meteen waarom:

Private Sub CommandButton1_Click()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim myStoryRange As Object
    Dim CreatWordInstance As Boolean
    
    If WordApp Is Nothing Then
        Set WordApp = CreateObject("Word.Application")
        CreatWordInstance = True
    Else
        Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\Templatetst.docx")
    
        For Each myStoryRange In WordDoc.StoryRanges
            With myStoryRange.Find
                .Text = "Dit is een Test"
                .Replacement.Text = "Zoeken en vervangen"
                .Execute Replace:=wdReplaceAll
            End With
            WordApp.Selection.Find.Execute FindText:="Zoeken en vervangen"
            'of activedocument.content.find.execute
            WordApp.Selection.Move Unit:=12, Count:=1
        Next myStoryRange
    End If
End Sub

Geef maar een seintje als je het niet ziet.

 

[Excelvbas01]

Ik ben dit vergeten: WordApp.Visible = True

Verder zie ik 't niet en er gebeurt nu ook helemaal niets. Ook geen foutmelding.

 

[AHulpje]

WordApp is altijd Nothing, dus wordt Word geopend en gebeurt er verder niets.
Probeer het eens zo:

Private Sub CommandButton1_Click()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim myStoryRange As Object
    
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    On Error GoTo 0
    
    If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\Templatetst.docx")

    For Each myStoryRange In WordDoc.StoryRanges
        With myStoryRange.Find
            .Text = "Dit is een Test"
            .Replacement.Text = "Zoeken en vervangen"
            .Execute Replace:=wdReplaceAll
        End With
        WordApp.Selection.Find.Execute FindText:="Zoeken en vervangen"
        'of activedocument.content.find.execute
        WordApp.Selection.Move Unit:=12, Count:=1
    Next myStoryRange
End Sub

 

[Excelvbas01]

Bedankt,
Ik heb t getest en merkt dat de code niet helemaal goed werkt. Zoeken gaat maar een richting op en dat is naar beneden. Gaat niet weer terug naar boven. Het zou mooi zijn als de code ook weer naar boven kan zoeken.

 

[AHulpje]

Ik vermoed dat je meerdere zoek- en vervang acties op hetzelfde document loslaat. Als je zo'n zoekactie start met

Selection.HomeKey Unit:=wdStory

dan begint die altijd bovenaan.

 

[snb]

De oplossing in #10 is het antwoord.

 

[Excelvbas01]

Top, dank jullie wel.