[Word 2007] Automatisch hyperlinks naar bookmarks maken

[Verwijderd]

Voor mijn stage ben ik nu bezig met het schrijven van een handleiding (een hele lange handleiding).

Dit bestaat uit vele oplossingen welke allemaal een eigen ID hebben (SOL000, waarvan de cijfers uiteraard oplopen). Iedere oplossing is een eigen bestand en dit wordt allemaal samengevoegd in 1 groot bestand bij het publiceren.

Elke oplossing is gebookmarked dit gaat allemaal prima wanneer je de bestanden samenvoegd blijven de bookmarks bestaan en hyperlinken naar deze bookmarks werkt ook prima.

Nu wordt er heel veel gerefereerd naar andere locaties (dus naar een SOL000 ID), en wanneer je hierop klikt ga je dus automatisch naar de juiste oplossing.

Dit werkt top! Echter moet ik het nu allemaal handmatig invullen, en dit zou ik graag geautomatiseerd zien, dus een script of oplossing die SOL000 text automatisch hyperlinkt naar een bookmark met dezelfde naam.

Dus als je SOL123 in het document hebt moet deze automatisch naar de bookmark met de naam SOL123 gelinkt.

Hebben jullie een idee hoe ik dit het beste kan doen? Ik heb (duh..) gegoogled maar het is een beetje lastig zoeken omdat ik niet precies weet waarop ik dan zou moeten zoeken. Dus hopelijk kunnen jullie me hierbij helpen!

[Rupie]

Kan je geen scriptje schrijven in Visual Basic? Bij een druk op de knop gaat die zoeken naar een deel van een string (SOL*** o.i.d., weet niet precies hoe je op een deel van een string moet zoeken) en als hij deze vind laat je hem het gehele woord selecteren en kopieren. Vervolgens laat je op die plek een hyperlink maken met de waarde die je gecopieerd hebt.

edit:
heb zelf even zitten spelen. met deze code kan ik op een deel van het woord zoeken, dit woord uitbreiden met het volgnummer en dit vervolgens vervangen door een link met dezelfde naam:

code:

Sub test()
'
' test Macro
' Macro opgenomen op 16-06-2009 door Rupie
'
    Selection.find.ClearFormatting
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.copy
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=Selection.Range, _
    SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range
End Sub

moet je er alleen zelf nog even voor zorgen dat hij linkt naar het goede (ik heb hem nu als link naar een extern document, het zou niet heel moelijk moeten zijn om in te stellen dat het naar een locatie in het document verwijst. Enige nadeel is wel dat als je nu een woord gebruikt waar 'sol' in voorkomt dat hij die ook gaat hyperlinken, wellicht dat je dat even zo moet aanpassen dat hij case sensitive wordt (MatchCase = True zou voldoende moeten zijn), de kans dat je een woord gebruikt waar 'SOL' in voorkomt lijkt mij niet zo heel groot.

nog even de uitleg erbij. dit stukje is voor de daadwerkelijke zoekopdracht:

code:

    Selection.find.ClearFormatting
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.find.Execute

wat ik hier doe is dat het ik zoekresultaat 'SOL' verleng met 3 karakters (het volgnummer) om het hele woord te selecteren. Hou er dus rekening mee dat je niet verder kan gaan dan 999 . Vervolgens kopieer ik dat wat ik geselecteerd heb:

code:

 Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.copy

tot slot ga ik dat wat ik gekopieerd heb ('SOL' + volgnummer) vervangen door een hyperlink met als 'Address' (dat waar je naar linkt) en als 'TextToDisplay' (de tekst die je ziet in word) dat wat ik gekopieerd heb (Selection.Range):

code:

ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=Selection.Range, _
    SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range

Je zal ook nog even wat moeten bouwen om ervoor te zorgen dat je de macro maar 1x uit hoeft te voeren, met de huidige code moet je hem keer op keer opnieuw uitvoeren. Ik weet overigens ook niet precies wat hij doet als hij een resultaat tegen komt wat al een link is. Er zijn nog wat haken en ogen dus, maar het begin is er

Edit2:
nu ook iets om ervoor te zorgen dat er geen problemen ontstaan bij een 'SOL' die al een link heeft. Ik zoek op SOL* met als style Hyperlink en wis vervolgens de style. het stuk 'Sub find()' is een nieuwe (2e) macro:

code:

Sub find()
'
' find2 Macro
' Macro opgenomen op 16-06-2009 door Rupie
'
    Selection.find.ClearFormatting
    Selection.find.Style = ActiveDocument.Styles("Hyperlink")
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = "*"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.find.Execute
End Sub

Sub test()
'
' test Macro
' Macro opgenomen op 16-06-2009 door Rupie
'
    Selection.find.ClearFormatting
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.copy
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=Selection.Range, _
    SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range
End Sub

Edit3:
de post wordt langer en langer met name omdat ik zelf net een beetje begin met spelen met Vb Heb nog een aanpassing gedaan. Heb nu 2 macro's, 1 om bestaande links te updaten (update) en 1 om nieuwe links te maken (check_new). Ik heb een style toegevoegd (Hype1, dikgedrukt en in een bijzonder kleurtje zodat het een unieke style is). als je een nieuwe link maakt moet je het woord (SOL001 bv) die style geven. Op het moment dat je check_new draait zoekt hij naar die style, in combinatie met 'SOL' en gaat die vervangen door een hyperlink. Op het moment dat je update gaat draaien gaat hij opzoek naar woorden die beginnen met SOL in de style Hyperlink en gaat die updaten.

code:

Sub update()
'
' test Macro
' Macro opgenomen op 16-06-2009 door Rupie
'
    Selection.find.ClearFormatting
    Selection.find.Style = ActiveDocument.Styles("Hyperlink")
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Selection.Range.Hyperlinks(1).Delete
    
    Selection.find.ClearFormatting
    With Selection.find
        .Text = "SOL"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.copy
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=Selection.Range, _
    SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range
End Sub

Sub check_new()
'
' check_new Macro
' Macro gemaakt op 16-06-2009 door Rupie
'
    Selection.find.ClearFormatting
    Selection.find.Style = ActiveDocument.Styles("Hype1")
    Selection.find.Replacement.ClearFormatting
    Selection.find.Replacement.Style = ActiveDocument.Styles("Hyperlink")
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.Font.bold = wdToggle
    Selection.copy
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=Selection.Range, _
    SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range
End Sub

[ Voor 149% gewijzigd door Rupie op 16-06-2009 12:09 ]

[Verwijderd]

Thanks man!

Ik heb het net even snel geprobeerd maar het werkt nog niet zoals ik wil. Ik ga er zo nog even naar kijken (nu vergaderingen enzo). Ik post het resultaat!

[Rupie]

Ik ben nog even bezig geweest, je moet wat doen om zelf een beetje handigheid te krijgen in VB

ondertussen heb ik 3 macro's:
1. doc_check_new om te kijken of er teksten zijn met de style 'hype1 Char' die omgezet moeten worden naar een link.
2. doc_update om bestaande links te checken. Als je de nummering verkeerd hebt en je past iets aan gaat deze alle verwijzingen nalopen. Ik heb voor de loop wel een max ingesteld om te voorkomen dat er problemen ontstaan. Max staat nu op 2, maar ik gok dat je die zelf wel wat hoger kan zetten. Als je hem te hoog zet zal zij zosnel als hij alle resultaten heeft gehad een foutmelding geven, als je op dat moment kiest voor 'beeindigen' heeft hij wel alles gedaan.
3. doc_delete om alle links te verwijderen. de woorden die gebruikt werden voor de link krijgen weer de style 'hype1 Char' om ervoor te zorgen dat je op een later tijdstip via de doc_check_new alle verwijzingen opnieuw aan te maken

code:

Sub doc_check_new()
'
' check_new Macro
' Macro gemaakt op 16-06-2009 door Rupie
'

    Selection.find.ClearFormatting
    Selection.find.Style = ActiveDocument.Styles("hype1 Char")
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
     End With
     Do While Selection.find.Execute = True
      Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
      Selection.ClearFormatting
      Selection.copy
      ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=Selection.Range, _
      SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range
    Loop
     
End Sub

code:

Sub doc_update()
'
' doc_update Macro
' Macro opgenomen op 16-06-2009 door Rupie
'
    Dim intCouter As Integer
    Selection.find.ClearFormatting
    Selection.find.Style = ActiveDocument.Styles("Hyperlink")
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Do While intCounter < 2
    Selection.find.Execute
    intCounter = intCounter + 1
    Selection.Range.Hyperlinks(1).delete
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.copy
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=Selection.Range, _
    SubAddress:="", ScreenTip:="", TextToDisplay:=Selection.Range
    Loop
End Sub

code:

Sub doc_delete()
'
' delete Macro
' Macro gemaakt op 16-06-2009 door Rupie
'

    Selection.find.ClearFormatting
    Selection.find.Style = ActiveDocument.Styles("Hyperlink")
    With Selection.find
        .Text = "SOL*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Do While Selection.find.Execute = True
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Style = ActiveDocument.Styles("hype1 Char")
    Selection.Range.Hyperlinks(1).delete
    Loop
    
End Sub

doc_check_new en doc_update zijn op dit moment wel zo ingesteld dat er een nutteloze link gemaakt wordt naar het woord in de style 'hype1 Char'. Die zal je nog even zo aan moeten passen dat hij een link maakt naar de juiste map en je zal er nog even een extensie achteraan moeten plakken. Ik ga nu eens aan de slag om een menutje te maken om de macro's aan te roepen

[ Voor 3% gewijzigd door Rupie op 17-06-2009 10:39 ]

[Verwijderd]

Ik ben ook even aan het rommelen geweest nadat ik je code heb bestudeerd

Die 3 macro's lijken me niet echt nodig want de volgende code...

code:

Sub RestoreLinks()
'
' Restore bookmarks & shortcuts
'
   Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "SOL[0-9][0-9][0-9]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    
    Selection.Find.Execute
    Do While Selection.Find.Execute = True
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:=Selection.Range, ScreenTip:="", TextToDisplay:=""
    Loop
    
End Sub

... doet eigenlijk precies wat ik wil...

Hij vervangt nu alle SOL000 woorden met snelkoppelingen naar bookmarks met dezelfde naam! Ook het opnieuw doen werkt gewoon, hij vervangt alles.

Rupie, big respect

Dankzij jou werkt het top!