Macro markeren van gebruikte stijlen Bold Italic ...

Status
Niet open voor verdere reacties.

Luccl

Gebruiker
Lid geworden
27 mei 2021
Berichten
13
Hallo,

ik ben bezig aan een macro waarbij de gebruikte tekenstijl gemarkeerd wordt in Word
naderhand zoek ik in Indesign naar deze unieke code om de opmaak terug te zetten

de macro loopt perfect enkel zoekt hij niet in de voetnoot tekst
reeds bedankt voor dit te lezen

Code:
Sub Markeer_opmaak()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
 'zoek ondelijnde tekst
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = True
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Font.Underline = True
  .Text = ""
  .Replacement.Text = "X€X^&X€XUn"
  .Execute Replace:=wdReplaceAll
  'zoek Bold italic
  .ClearFormatting
  .Font.Bold = True
  .Font.Italic = True
  .Replacement.Text = "X€X^&X€XBoIt"
  .Execute Replace:=wdReplaceAll
 'zoek italic
  .ClearFormatting
  .Font.Italic = True
    .Font.Bold = False
  .Replacement.Text = "X€X^&X€XIt"
  .Execute Replace:=wdReplaceAll
 'zoek Bold
    .ClearFormatting
      .Font.Italic = False
    .Font.Bold = True
  .Replacement.Text = "X€X^&X€XBo"
  .Execute Replace:=wdReplaceAll
   'zoek kleinkapitaal
    .ClearFormatting
      .Font.Italic = False
    .Font.SmallCaps = True
  .Replacement.Text = "X€X^&X€XKl"
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub
 
Allereerst welkom bij HelpMij. Plaats eens een voorbeeld document met de macro; dat scheelt ons heel wat typwerk. En die steek ik liever in het kijken naar de oplossing :)
 
de code heb ik aangepast in mijn eerste bericht
hierbij een voorbeeld word document
 

Bijlagen

  • Test2_LC.docx
    50,1 KB · Weergaven: 27
Laatst bewerkt:
Ik vermoed dat de macro er niet in ziet, gezien het feit dat het een docx bestand is?
 
het is eigelijk een vba code die ik op meerdere documenten wil laten draaien
noemt dit niet een macro?

Code:
Sub Markeer_opmaak()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
 'zoek ondelijnde tekst
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = True
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Font.Underline = True
  .Text = ""
  .Replacement.Text = "X€X^&X€XUn"
  .Execute Replace:=wdReplaceAll
  'zoek Bold italic
  .ClearFormatting
  .Font.Bold = True
  .Font.Italic = True
  .Replacement.Text = "X€X^&X€XBoIt"
  .Execute Replace:=wdReplaceAll
 'zoek italic
  .ClearFormatting
  .Font.Italic = True
    .Font.Bold = False
  .Replacement.Text = "X€X^&X€XIt"
  .Execute Replace:=wdReplaceAll
 'zoek Bold
    .ClearFormatting
      .Font.Italic = False
    .Font.Bold = True
  .Replacement.Text = "X€X^&X€XBo"
  .Execute Replace:=wdReplaceAll
   'zoek kleinkapitaal
    .ClearFormatting
      .Font.Italic = False
    .Font.SmallCaps = True
  .Replacement.Text = "X€X^&X€XKl"
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub
 
Dan komt er een stukje bij in de macro, omdat de Voetnoten een ander deel van het document zijn. Een document bevat verschillende StoryRanges, die je allemaal apart kunt benaderen. Voetnoten doe je dus zo:
Code:
    With ActiveDocument.StoryRanges(wdFootnotesStory).Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = True
        .Forward = True
        .MatchWildcards = True
        .Wrap = wdFindContinue
        .Font.Underline = True
        .Text = ""
        .Replacement.Text = "X€X^&X€XUn"
        .Execute Replace:=wdReplaceAll
        'zoek Bold italic
        .ClearFormatting
        .Font.Bold = True
        .Font.Italic = True
        .Replacement.Text = "X€X^&X€XBoIt"
        .Execute Replace:=wdReplaceAll
        'zoek italic
        .ClearFormatting
        .Font.Italic = True
        .Font.Bold = False
        .Replacement.Text = "X€X^&X€XIt"
        .Execute Replace:=wdReplaceAll
        'zoek Bold
        .ClearFormatting
        .Font.Italic = False
        .Font.Bold = True
        .Replacement.Text = "X€X^&X€XBo"
        .Execute Replace:=wdReplaceAll
        'zoek kleinkapitaal
        .ClearFormatting
        .Font.Italic = False
        .Font.SmallCaps = True
        .Replacement.Text = "X€X^&X€XKl"
   End With
 
Bedankt OctaFish

is er een mogelijkheid om dit op alles toe te passen ongeacht welke StoryRanges
ik moet zeker zijn dat dit overal uitgevoerd is het gaat hier om boeken van +/-1000 pagina's
in verschillende delen
 
Ja, dat kan wel. Dan krijg je zo'n constructie:
Code:
    For Each myStoryRange In ActiveDocument.StoryRanges
        myStoryRange.Find.Execute FindText:="Microsoft Word", Forward:=True
        While myStoryRange.Find.Found
            myStoryRange.Italic = True
            myStoryRange.Find.Execute FindText:="Microsoft Word", Forward:=True
        Wend
        While Not (myStoryRange.NextStoryRange Is Nothing)
            Set myStoryRange = myStoryRange.NextStoryRange
            myStoryRange.Find.Execute FindText:="Microsoft Word", Forward:=True
            While myStoryRange.Find.Found
            myStoryRange.Italic = True
            myStoryRange.Find.Execute FindText:="Microsoft Word", Forward:=True
        Wend
        Wend
    Next myStoryRange

Dit voorbeeldje vervangt tekt in alle storyranges, maar kun je denk ik wel aanpassen.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan