Word VBA, Loop "tekst zoeken en verwijderen"

[remcop1989]

Vanuit een systeem worden offertes gegenereerd in Word. Na het genereren is er steeds een standaard opmaak waarin de offerte gezet wordt middels VBA. Dit is tijdbesparend en makkelijker.

In de offerte zit een stuk tekst "*REGELVERWIJDEREN*".
Deze tekst (inclusief de "*") komt uit het systeem en betekent dat bepaalde data niet beschikbaar is. Op de plaatsen waar deze data niet beschikbaar is zet hij voornoemde tekst neer.
In de macro heb ik een stukje code opgenomen dat deze tekst in het Word document zoekt en verwijderd.

Zie voorbeeld in bijlage.
De code start middels de module "checktext":

Sub checktext()
With ActiveDocument.Content.Find
    .Text = "Deze offerte is gemaakt met behulp van Accountview."
    .Forward = True
    .Execute
        If .Found = True Then
            FormatTableQuotationLines_NL
            ActiveDocument.Activate
            Else: With ActiveDocument.Content.Find
                    .Text = "Dieses Angebot ist erstellt an hand von Accountview."
                    .Forward = True
                    .Execute
                        If .Found = True Then
                        FormatTableQuotationLines_DE
                            Else: With ActiveDocument.Content.Find
                                .Text = "This quotation has been made with Accountview."
                                .Forward = True
                                .Execute
                                    If .Found = True Then
                                    FormatTableQuotationLines_EN
                                    ElseIf .Found = False Then
                                    MsgBox "Deze macro is enkel geschikt voor Accountview offertes of deze taalcode is nog niet beschikbaar. Contacteer de systeembeheerder voor meer informatie"
                                    Exit Sub
                                    End If
                                  End With
                             End If
                End With
        End If
End With

End Sub

Deze module start "formattablequotationlines":

Sub FormatTableQuotationLines_NL()
    
    Dim tbl As Table
    Dim r As Integer
    Dim c As Integer
    Dim strVal1 As String
    Dim strVal2 As String
    Dim strVal3 As String
    Dim strVal4 As String
    Dim strPrev As String
    Dim WnWord As Object
    
    If ActiveDocument.Tables.Count < 2 Then
        ' Verlaat macro er zijn geen tabellen beschikbaar.
        Exit Sub
    End If
    
    ' Ga de 2e tabel doorlopen.
    Set tbl = ActiveDocument.Tables(2)
    
    If tbl.Rows.Count > 0 Then
        strVal1 = tbl.Cell(1, 1).Range.Text
        strVal1 = Trim(Left(strVal1, Len(strVal1) - 2))
        If Len(strVal1) = 0 Then
            MsgBox "Formatering van offerteregels is reeds uitgevoerd."
            Exit Sub
        End If
    End If
    
    On Error Resume Next
    
    Selection.InsertRowsAbove 1
        
    For r = 1 To tbl.Rows.Count + 1
             
        strVal1 = tbl.Cell(r, 1).Range.Text
        ' Verwijder regeleindes
        strVal1 = Trim(Left(strVal1, Len(strVal1) - 2))
        
        strVal2 = tbl.Cell(r, 2).Range.Text
        ' Verwijder regeleindes
        strVal2 = Trim(Left(strVal2, Len(strVal2) - 2))
        
        strVal3 = tbl.Cell(r, 3).Range.Text
        ' Verwijder regeleindes
        strVal3 = Trim(Left(strVal3, Len(strVal3) - 2))
               
        strVal4 = tbl.Cell(r, 4).Range.Text
        ' Verwijder regeleindes
        strVal4 = Trim(Left(strVal4, Len(strVal3) - 2))
            
       If strVal1 = Empty And strVal2 = Empty And strVal3 <> Empty Then
            'tbl.Cell(r, 1).Merge MergeTo:=tbl.Cell(r, 2)
            tbl.Cell(r, 1).Merge MergeTo:=tbl.Cell(r, 3)
            If LCase(Left(tbl.Cell(r, 1).Range.Text, 6)) = "let op" Then
                ' Cursief weergeven en niet vet
                tbl.Cell(r, 1).Range.Italic = True
                tbl.Cell(r, 1).Range.Bold = False
            Else
                ' Anders alleen vet formateren
                tbl.Cell(r, 1).Range.Bold = True
                tbl.Cell(r, 2).Range.Bold = True
                tbl.Cell(r, 3).Range.Bold = True
                tbl.Cell(r, 4).Range.Bold = True
            End If
             
        Else
             
        End If
    
            'probeer de laatste kolom te vullen met "Eenmalig € totaal" indien het gaat om eenmalige kosten
            If strVal1 = Empty And strVal2 = Empty And strVal3 <> Empty Then
            If LCase(Left(tbl.Cell(r, 1).Range.Text, 16)) = "eenmalige kosten" Then
            With Selection.Find
                .ClearFormatting
                .Text = LCase(Left(tbl.Cell(r, 1).Range.Text, 16)) = "eenmalige kosten"
                .Wrap = wdFindContinue
                .Execute
                tbl.Cell(r, 2).Range.Text = "Eenmalig € totaal"
            End With
            End If
            End If
                            
    Next r
    
    'ga nu de tabelregel met kopjes voorzien van lijntjes boven en onder de regel
    For c = 1 To tbl.Columns.Count
        tbl.Cell(1, c).Select
        With Selection.Cells
            .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
            .Borders(wdBorderRight).LineStyle = wdLineStyleNone
            .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
            .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
            
            .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
            .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
            .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
            .Borders.Shadow = False
        End With
    Next

    'voeg een lege regel in ONDER de kopjes van de tabel
    tbl.Cell(2, c).Select
    Selection.InsertRowsBelow 1
    Selection.Borders(wdBorderBottom).LineStyle = False
    
    
    
    
    'zoek de tekst "regelverwijderen" en verwijder deze. Herhaal dit tot niets meer gevonden wordt
    regelverwijderen_loop
    
    
    
    'roep de macro aan om de "zoektekst" te verwijderen
    With Selection.Find
        .ClearFormatting
        .Text = "Deze offerte is gemaakt met behulp van Accountview."
        .Wrap = wdFindContinue
        .Execute
        Selection.Delete
    End With
    
    'roep de macro aan om de "zoektekst" te verwijderen
    With Selection.Find
        .ClearFormatting
        .Text = "Wissel paginarichting"
        .Wrap = wdFindContinue
        .Execute
        Selection.Delete
    End With

    ' kijk of er een nutteloos '-' teken staat in het adres en probeer hem te verwijderen
    With Selection.Find
        .ClearFormatting
        .Text = "- *REGELVERWIJDEREN*"
        .Wrap = wdFindContinue
        .Execute
            ' Selection.Delete
            Selection.TypeBackspace
            Selection.TypeBackspace
    End With
    

    
    'If we find one then we can set off a loop to keep checking
    'I always put a counter in to avoid endless loops for one reason or another
    ' Do While Selection.Find.Found = True And iCount < 8
    '     iCount = iCount + 1

     
        'Jump back to the start of the document.  Since you remove the
        'footnote place holder this won't pick up old results
    '    Selection.HomeKey Unit:=wdStory
    '    Selection.Find.Execute
        
        'On the last loop you'll not find a result so check here
    '    If Selection.Find.Found Then
        
            'probeer in het adres de lege regels te verwijderen
   '         With Selection.Find
   '             .ClearFormatting
'                .Text = "*REGELVERWIJDEREN*"
'                .Wrap = wdFindContinue
'                .Execute
'                Selection.TypeBackspace
'                Selection.TypeBackspace
'                Selection.HomeKey Unit:=wdStory
'            End With
'        End If
'    Loop
    
    'vergroot de tabelbreedte naar 18,28 centimeter
    tbl.PreferredWidthType = wdPreferredWidthPoints
   Rem tbl.PreferredWidth = CentimetersToPoints(18.53)
    tbl.PreferredWidth = CentimetersToPoints(17.78)
    
End Sub

In deze laatste module staan de volgende 2 regels:

    'zoek de tekst "regelverwijderen" en verwijder deze. Herhaal dit tot niets meer gevonden wordt
    regelverwijderen_loop

De regelverwijderen_loop staat ook in het document en ziet er als volgt uit:

Sub regelverwijderen_loop()
    Do While Selection.Find.Found = True And iCount < 8
    iCount = iCount + 1
    
    Selection.HomeKey Unit:=wdStory
    Selection.Find.Execute
    
      If Selection.Find.Found Then
    
            With Selection.Find
                .ClearFormatting
                   .Text = "*REGELVERWIJDEREN*"
                .Wrap = wdFindContinue
                .Execute
                Selection.Delete
                Selection.TypeBackspace
            End With
    
      End If
    
    Loop
End Sub

Zonder loop krijg ik hem wél werkend:

[code
With Selection.Find
.ClearFormatting
.Text = "*REGELVERWIJDEREN*"
.Wrap = wdFindContinue
.Execute
Selection.Delete
Selection.TypeBackspace
End With
[/code]

Zodra ik hem in de loop zet werkt hij niet meer.

Wie helpt?


PS: sorry voor de lange post, maar ik mocht helaas geen .docm uploaden.

 

[OctaFish]

En waar moet dan de zoektekst staan? Je levert een (vermoed ik) geschoond bestand aan, zodat de macro niks doet.

 

[remcop1989]

Het bestand dat ik aanlever is niet geschoond volgens mij. Er staat geen Macro in want zo'n bestand mag ik hier niet uploaden. Als het goed is staat op de eerste pagina in de adres regels (meteen bovenaan) die zoektekst....?

Mocht dat niet zo zijn, dan kijk ik vanavond even op mijn pc en zal ik een juist bestand hier neerzetten.

 

[snb]

Wat is doet is volledig overbodig als je in Word met documentvariabelen werkt.
Dan hoef je in een Word-sjabloon alleen de teksten die variabel zijn ('What's in a name ?) te actualiseren (fields.update). Klaar ben je.

 

[remcop1989]

Wat is doet is volledig overbodig als je in Word met documentvariabelen werkt.
Dan hoef je in een Word-sjabloon alleen de teksten die variabel zijn ('What's in a name ?) te actualiseren (fields.update). Klaar ben je.

Ik snap totaal niet wat je bedoeld???

 

[OctaFish]

Bedoeld is met een t. Maar dit terzijde. De opzet van je offerte is, op zijn zachtst gezegd, niet erg handig. Dat moet een heel stuk slimmer kunnen, zeker als je de verschillende variabele teksten in je document zet met (bijvoorbeeld, zoals snb suggereert) met het veld DocVariable. Daar kun je namelijk heel veel mee doen. Zeker voor een sjabloon is jouw techniek niet echt handig.
Overigens heb ik jouw macro's gewoon in je document geplakt, en gedraaid. Maar je hoofdmacro vindt dus echt niks... Er valt dus weinig te testen. Nog afgezien van de fouten die ik in eerste instantie kreeg omdat de talen (en bijbehorende fucnties) ontbraken. Maar die functie aanroepen zijn makkelijk uit te zetten, dus dat was verder geen probleem.

 

[remcop1989]

Ik vermoed dat jullie het enigszins verkeerd begrijpen.

Wij maken gebruik van het systeem Accountview. Dit systeem omvat alles van relatiebeheer (CRM) tot offertes, inkoopopdrachten, facturatie etc.
In dit systeem voeren wij gegevens in, waarna middels een druk op de knop de ingevoerde gegevens "op de achtergrond" door het systeem in een Word-bestand worden gezet. Hier hebben wij verder geen omkijken naar. Zolang wij de gegevens in het systeem invoeren, zorgt hij er automatisch voor dat deze in het Word-document komen. Zodra ze dan ook in het systeem staan, hoef ik niets meer te doen dan een knop in te drukken en de offerte verschijnt in Word. Ik hoef niet zelf iets in Word in te voeren.

Daarbij zie ik nu ook dat ik het verkeerde document heb toegevoegd hierboven. Dat was een document waar de macro reeds overheen gelopen heeft. In de bijlage van deze post heb ik het juiste bestand geplaatst. Dit is de offerte zoals hij er uit het systeem uitkomt. De volledige en juiste code die jullie in het VBA deel van de offerte als module moeten plakken staat in het document "code" in bijlage.

De tabel op pagina 2 wordt door het systeem Accountview zelf erin gezet. Echter wil ik deze tabel op een bepaalde manier laten opmaken voordat hij als PDF naar de klant gaat. Dat is wat mijn macro doet. Accountview is niet in staat de offerte zo op te maken als ik dat wil. Vandaar dus de macro.

Wat ik doe is macro "checktext" starten. Deze controleert eerst of de zin "Deze offerte is gemaakt met behulp van Accountview." in het document staat in het Nederlands, Duits of Engels. Indien gevonden, start hij vervolgens de macro "formattablequotationlines" in het Nederlands, Duits of Engels (afhankelijk van de taal waarin voornoemde zin geschreven staat uiteraard).

Het kan voorkomen dat wij van een klant niet het volledige adres hebben. In dat geval vult hij de lege regels van het adres met:

*REGELVERWIJDEREN*

Middels de volgende code krijg ik 1 zo'n regel verwijderd:

With Selection.Find
.ClearFormatting
.Text = "*REGELVERWIJDEREN*"
.Wrap = wdFindContinue
.Execute
Selection.Delete
Selection.TypeBackspace
End With

(code staat ook in de macro's)

Echter verwijdert hij deze tekst dan maar op 1 plek en niet overal waar dit staat. Middels de volgende loop probeer ik hem de tekst continue te laten zoeken en verwijderen totdat hij niets meer vindt:

Sub regelverwijderen_loop()
    Do While Selection.Find.Found = True And iCount < 8
    iCount = iCount + 1
    
    Selection.HomeKey Unit:=wdStory
    Selection.Find.Execute
    
      If Selection.Find.Found Then
    
            With Selection.Find
                .ClearFormatting
                   .Text = "*REGELVERWIJDEREN*"
                .Wrap = wdFindContinue
                .Execute
                Selection.Delete
                Selection.TypeBackspace
            End With
    
      End If
    
    Loop
End Sub

Deze laatste code doet gewoon helemaal niets.

Is het nu duidelijker wat ik bedoel?

 

[OctaFish]

Ik mag het dan niet goed begrijpen, ik had wel gelijk (berichtje #2). Ik geef je nieuwe bestandjes nog een nieuwe kans

 

[remcop1989]

Bedankt voor de 2e kans in berichtje #2 heb je inderdaad gelijk dat het een geschoond bestand was zoals ik al aangaf.

Met betrekking tot die sjablonen: programma Accountview zorgt voor het vullen van een Word document op basis van de in Accountview ingevoerde gegevens. Het enige waar ik invloed op heb is:
- welke gegevens vanuit Accountview in Word komen te staan
- waar deze komen te staan
- in beperkte mate de opmaak van deze gegevens.

Ik hoor het graag van jullie.

 

[remcop1989]

UPDATE

Ik heb nu (per toeval) iets vreemds ontdekt.

In bijlage van deze post 2 offerte-documenten.

Ik denk dat het voor zich spreekt maar toch:
- de code werkt wel in document "werkt wel"
- de zelfde code werkt niet in document "werkt niet".

De documenten zijn in de basis vrijwel hetzelfde, de code is exact hetzelfde, maar toch werkt hij niet.


EDIT:
Heb nu gezien dat bovenstaande ook niet altijd het geval is. Ik ben in ieder geval "aan het eind van mijn Latijn" in dezen.