Je Formatierungen anderen Hintergrund, zur Erkennu

Computer: Software & Programmierung Visual Basic
#1

Hallo liebe Rübennasen,
ich möchte in einem Word Dokument für einige Formatierungen (Schrift Name, Schriftgröße usw.) Hintergrundfarbe einen selbst sein, damit ich beim korrigieren eine falsche Formatierungen schneller erkennen kann.Ich habe ein Makro fertig aber es läuft total langsam.
Ich glaube es liegt am Suchenmuster?
Vielleicht hat jemand einen Verbesserungsvorschlag?
Vielen Dank
w

Sub findFont()
 Selection.Find.ClearFormatting
 With Selection.Find
 .Text = "?@"
 .Text = "\*?\*"
 .Forward = True
 .Wrap = wdFindContinue
 .Format = True
 With .Font
 .Size = 11
 .name = "Arial Narrow"
 End With

 With .Replacement
 .Text = "^&" ' es soll wieder der gleiche text eingesetzt werden.
 '.Highlight = True
 End With
 .MatchCase = False
 .MatchWholeWord = False
 .MatchAllWordForms = False
 .MatchSoundsLike = False
 .MatchWildcards = True
 End With

 'Selection.Find.Execute Replace:=wdReplaceAll
 Selection.Find.Execute

 Exit Sub

 With Selection
 While .Find.Execute 'suchen bis zum Ende
 '.Range.HighlightColorIndex = wdYellow 'Fundstelle gelb hervorheben
 .Range.HighlightColorIndex = wdRed 'Fundstelle rot hervorheben
 Wend
 End With

End Sub
#2

ich möchte in einem Word Dokument für einige Formatierungen
(Schrift Name, Schriftgröße usw.) Hintergrundfarbe einen
selbst sein, damit ich beim korrigieren eine falsche
Formatierungen schneller erkennen kann.Ich habe ein Makro
fertig aber es läuft total langsam.
Ich glaube es liegt am Suchenmuster?
Vielleicht hat jemand einen Verbesserungsvorschlag?

Hi Zwergnase :smile:,

schau mal in den Link auf der Brettbeschreibung vom Word-Brett, da gibt es auch viel Vba für Word, schau dir da die Suchroutinen an…

Ansonsten das auf jeden Fall tun:

Sub findfont()
On Error GoTo Ende
Application.ScreenUpdating = False

’ weiterer Code

Ende:
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard

#3

bitte .Wrap = wdFindStop einfügen
hi auch :smile:
bitte .Wrap = wdFindStop einfügen
/ verwenden.
sonst läufts ewig.
lg w

#4

hier die Lösung
so gehts einigermassen flott:

Sub findFont()
'
' findFont Makro
' Makro aufgezeichnet am 13.12.2008 von lauffer
'
On Error GoTo Ende
Application.ScreenUpdating = False

 Selection.HomeKey Unit:=wdStory

 With Selection.Find
 .ClearFormatting
 .Text = "?@"
 .Text = "\*?\*"
 .Forward = True
 .Wrap = wdFindContinue
 .Format = True
 With .Font
 .Size = 11
 .name = "Arial Narrow"
 End With

 With .Replacement
 .ClearFormatting
 .Text = "^&" ' es soll wieder der gleiche text eingesetzt werden.
 '.Highlight = True
 End With
 .MatchCase = False
 .MatchWholeWord = False
 .MatchAllWordForms = False
 .MatchSoundsLike = False
 .MatchWildcards = True
 End With

 'Selection.Find.Execute Replace:=wdReplaceAll
 'Selection.Find.Execute

 'Exit Sub

 With Selection
 While .Find.Execute 'suchen bis zum Ende
 '.Range.HighlightColorIndex = wdYellow 'Fundstelle gelb hervorheben
 .Range.HighlightColorIndex = wdRed 'Fundstelle rot hervorheben
 .MoveRight Unit:=wdCharacter, Count:=1
 Wend
 End With

Ende:
Application.ScreenUpdating = True

End Sub