[VBA] Vertaalhulp maken met Word *

[Chippy4444]

Hallo helpers van Nederland.

Ik had het idee om de auto correctie functie in Word te gebruiken als vertaal hulp.
Ik heb dit geprobeerd door handmatig een aantal Nederlandse en Engelse woorden in de auto correctie functie te plaatsen en daarna de taal onder in het scherm in te stellen op Engels (Groot-Brittannië).
Het gevolg hiervan is inderdaad dat wanneer ik ben Nederlands woord wat ik heb ingevoerd in auto correctie automatisch wordt vervangen door het Engelse woord.

Tot zover is het idee geslaagd.

Nu had ik het idee gekregen om in VBA een programma te schrijven wat mij kan helpen om op een eenvoudige manier veel
(Nederlandse/Engelse) woorden toe te voegen aan de auto correctie lijst.

Nu heb ik wat ervaring met een wat oudere programmeertaal (Quick Basic), en een heel klein beetje van visual Basic.
Maar de nieuwe instructies in VBA m.b.t. Word zijn voor mij onbekend.

Ik heb met de macro recorder een aantal handelingen opgenomen die ik na mijn inziens nodig had om in een dergelijk programma te gebruiken.

Maar het programma doet nog niet helemaal wat ik wil, mijn vraag is dan ook of er iemand is die wat meer ervaring heeft met VBA en er voor mij evenaar wil kijken wat ik nu precies fout doe.

code:

Sub Vertaal() 
' 
' 
Dim WD1 As String 
Dim WD2 As String 

Selection.Find.ClearFormatting 
Selection.Find.Replacement.ClearFormatting 
With Selection.Find 
.Text = "*" 
.Replacement.Text = " " 
.Forward = True 
.Wrap = wdFindContinue 
.Format = False 
.MatchCase = False 
.MatchWholeWord = False 
.MatchWildcards = False 
.MatchSoundsLike = False 
.MatchAllWordForms = False 
End With 
wordenToevoegen 
Selection.Find.Execute Replace:=wdReplaceAll 

End Sub


Sub wordenToevoegen() 

Selection.Find.Execute 
Selection.MoveRight Unit:=wdWord, Count:=1 
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend 
WD1 = Selection.Text 
WD1 = Trim(LCase(WD1)) 

Selection.Find.Execute 
Selection.MoveRight Unit:=wdWord, Count:=1 
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend 
WD2 = Selection.Text 
WD2 = Trim(LCase(WD2)) 

AutoCorrect.Entries.Add WD1, WD2 
With AutoCorrect 
.CorrectInitialCaps = True 
.CorrectSentenceCaps = False 
.CorrectDays = True 
.CorrectCapsLock = True 
.ReplaceText = True 
.ReplaceTextFromSpellingChecker = True 
.CorrectKeyboardSetting = False 
.DisplayAutoCorrectOptions = True 
.CorrectTableCells = True 
End With 

End Sub

De bedoeling van het programma is om te zoeken naar een * en de twee woorden die rechts van het sterretje staan toe te voegen aan de auto correctie lijst. (* woord1 woord2)....

Op het moment dat hij het sterretje gevonden heeft moet hij het vervangen voor een Spatie, en de twee woorden aan de rechterkant van het sterretje toevoegen aan de auto correctie lijst.

En vervolgens moet hij verder zoeken in het document of dit sterretje nog vaker voorkomt in het document.
Ik wilde het sterretje vervangen voor een spatie om te voorkomen dat de woorden die naast het sterretje staan opnieuw aan de lijst worden toegevoegd wanneer het programma opnieuw gestart wordt, en om te voorkomen dat het zoeken naar het sterretje in een lus terechtkomt.

Is er iemand die het programma voor mij zo kan aanpassen dat het wel werkt.

Volgens mij ben ik al een heel eind op weg.

Bij voorbaat dank...

[ Voor 1% gewijzigd door curry684 op 25-10-2003 09:25 ]

[curry684]

_{Titel 20 keer verduidelijkt, "VBA hulp nodig" dekt de lading niet echt}

[Chippy4444]

curry684 schreef op 25 October 2003 @ 09:26:
_{Titel 20 keer verduidelijkt, "VBA hulp nodig" dekt de lading niet echt}

Ben ik met je eens, bedankt voor je hulp.....

Nu maar hopen dat iemand mij kan helpen....

[Lister]

Ik heb het als volgt aan de praat gekregen:

Als eerste heb ik de volgende regel als eerste regel in Vertaal gezet, hiermee wordt de cursor helemaal bovenaan in het document gezet.

code:

Selection.HomeKey Unit:=wdStory

En de 2 regels onder de End With heb ik vervangen door deze regels:

code:

Do While Selection.Find.Execute
    wordenToevoegen
    Selection.MoveDown Unit:=wdParagraph
Loop

Met de Find.Execute zoekt hij een "*" op en gaat hij naar de eerstvolgende regel waarin hij die vindt en wordenToevoegen verwerkt dan die regel.
Met de MoveDown Paragraph ga je naar de volgende regel zodat hij vanaf daar verder zoekt.
De While zorgt ervoor dat dit uitgevoerd wordt zolang hij nog een "*" vindt, en doordat het zoeken helemaal bovenaan in het document begint zal hij automatisch stoppen als het einde van het document is bereikt.

In de wordenToevoegen sub moet je dan wel de eerste regel met Selection.Find.Execute weghalen anders slaat hij een regel over

Zolang je nog aan het testen ben zou ik trouwens de volgende regels voor de regel met "AutoCorrect.Entries.Add" zetten, dit zorgt ervoor dat je in het debugwindow duidelijk kan zien wat er gebeurt en je AutoCorrect wordt niet vervuild. Als het zoeken verder naar wens werkt kan je die regels weer weghalen.

code:

Debug.Print "Adding (" & WD1 & "),(" & WD2 & ")"
Exit Sub

In deze code zit trouwens geen foutafhandeling of iets dergelijks, als er na een * bijvoorbeeld maar een woord staat zal het misgaan maar om dat allemaal dicht te timmeren wordt redelijk uitgebreid en dan zal je bestaande code redelijk omgegooid moeten worden.

Edit:
Waarom werken quotes en ampersands niet in mijn code tags en bij jou wel??

[ Voor 13% gewijzigd door Lister op 25-10-2003 14:42 . Reden: Vaag gedoe met quotes ]

[Chippy4444]

ik heb de aanbevelingen over genomen in de code, en het lijkt inderdaad te werken.

alleen worden het * bij mij niet verwijderd ??

De code ziet er bij mij nu zo uit....

code:

sub Vertaal()

Selection.HomeKey Unit:=wdStory

Dim WD1 As String
Dim WD2 As String
    
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "*"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

Do While Selection.Find.Execute
    wordenToevoegen
    Selection.MoveDown Unit:=wdParagraph
Loop
        
End Sub

Sub wordenToevoegen()

    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    WD1 = Selection.Text
    WD1 = Trim(LCase(WD1))
         
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdWord, Count:=1
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    WD2 = Selection.Text
    WD2 = Trim(LCase(WD2))
   
    AutoCorrect.Entries.Add WD1, WD2
    With AutoCorrect
        .CorrectInitialCaps = True
        .CorrectSentenceCaps = False
        .CorrectDays = True
        .CorrectCapsLock = True
        .ReplaceText = True
        .ReplaceTextFromSpellingChecker = True
        .CorrectKeyboardSetting = False
        .DisplayAutoCorrectOptions = True
        .CorrectTableCells = True
    End With

End Sub

[Lister]

Chippy4444 schreef op 25 October 2003 @ 17:02:
alleen worden het * bij mij niet verwijderd ??

Dat klopt ik had dat weggelaten omdat hij toch altijd maar een keer van boven naar beneden zoekt, maar als dat toch vervangen moet worden, moet je de While-regel als volgt aanpassen:

code:

Do While Selection.Find.Execute(Replace:=wdReplaceOne)

Hierbij vervangt hij per keer een "*"-teken (.Text) met een " "-teken (.Replacement.Text)

[Chippy4444]

Het programma doet nu ongeveer wat ik graag had willen hebben..

ik ben je zeer dankbaar voor je hulp, en je uitleg.

ik ben nog opzoek naar een boek over VBA (word) dat net zo duidelijk is, heb je misschien een suggestie...........

M.V.G Chippy..

[Lister]

Daar kan ik je niet echt mee helpen, misschien dat er in de FAQ van dit forum wat bruikbare links staan?

Ik heb het allemaal in de praktijk geleerd en heb ook al flink wat ervaring met standaard VB.

Als je wat moet maken in Word dan doe ik dat altijd via een macro opnemen, dan 1 keer handmatig doen wat er moet gebeuren en dan de opgenomen macrocode naar wens aanpassen en verfraaien.
Maar als je dan met loops en zo moet gaan werken is wat basis programmeerkennis ook wel handig.

Veel succes verder