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
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 ,
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
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