#16
|
|||
|
|||
This is an improved version of the code form post 11:
Code:
Sub Authors() 'Format all surnames (found according to their specific signs) in the selected range. Dim rng As range Application.ScreenUpdating = False Set rng = selection.range With rng.Find .ClearFormatting .Replacement.ClearFormatting .text = "[Vv]gl. @<[A-Z][!A-Z][a-z]@>" .Forward = True .MatchWildcards = True .Wrap = wdFindStop While .Execute rng.MoveStartUntil cset:=" " rng.Font.Italic = True rng.Font.AllCaps = True rng.Collapse wdCollapseEnd Wend End With Application.ScreenUpdating = True Set rng = Nothing End Sub |
#17
|
|||
|
|||
I hope it will help.
|
#18
|
|||
|
|||
Sorry to bother you again. It does not seem to work in Footnotes, only in the maintext. Do you know why? Cheers!
|
#19
|
|||
|
|||
I tried to change the vivkas code so that it would work in the footnotes aswell. But it doesnt seem to. Can someone help?
Code:
Sub FormatAuthorNamesInSmallCaps() Dim rng As Range Dim authorNames As Variant Dim footnote As Footnote Application.ScreenUpdating = False Set rng = ActiveDocument.Range 'Liste der Autorennamen authorNames = Array("Ackermann", "Angermann", _ "Andersen", "Atzeni", "Baecker", "Ortmann", _ "Zamoyski", "Ziegler", "Wurzbach", "Zittel", _ "Zürcher", "Zytphen-Adeler") ' Formatierung im Haupttextkörper For i = 0 To UBound(authorNames) Call FormatRange(rng, authorNames(i)) Next i ' Formatierung in den Fußnoten For Each footnote In ActiveDocument.Footnotes Set rng = footnote.Range For i = 0 To UBound(authorNames) Call FormatRange(rng, authorNames(i)) Next i Next footnote Application.ScreenUpdating = True End Sub ' Hilfsfunktion zur Formatierung eines Bereichs Sub FormatRange(ByRef rng As Range, ByVal searchText As String) With rng.Find .ClearFormatting .Replacement.ClearFormatting .Text = searchText .Forward = True .Wrap = wdFindStop .MatchWholeWord = True While .Execute rng.Font.Italic = True rng.Font.SmallCaps = True rng.Collapse wdCollapseEnd Wend End With End Sub |
#20
|
|||
|
|||
Hi, landrob1, and dear lurkers! Try this:
Code:
Sub Authors() 'Format all surnames (found according to their specific signs) in the whole doc '(all story ranges). Dim myStoryRng As range Dim rng As range Application.ScreenUpdating = False For Each myStoryRng In ActiveDocument.StoryRanges Set rng = myStoryRng With rng.Find .ClearFormatting .Replacement.ClearFormatting .text = "[Vv]gl. @<[A-Z][!A-Z][a-z]@>" .Forward = True .MatchWildcards = True .Wrap = wdFindStop While .Execute rng.MoveStartUntil cset:=" " rng.Font.Italic = True rng.Font.AllCaps = True rng.Collapse wdCollapseEnd Wend End With Next myStoryRng Application.ScreenUpdating = True Set rng = Nothing End Sub |
Tags |
chatgpt, names, vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Printing list of names in a publisher or word document | Marcia | Word | 2 | 09-27-2018 01:28 AM |
How to find CAPITALIZED names and change them into small caps | dylan.ve | Word VBA | 5 | 02-25-2016 03:15 PM |
Find and replace inside strings containing various names | audioman | Word VBA | 4 | 03-25-2014 11:19 AM |
Word Form / VBA Solution for Formatted Document | elmousa68 | Word VBA | 5 | 10-15-2013 05:10 PM |
find author names in text | anil3b2 | Word | 0 | 08-02-2010 04:12 AM |