#1
|
|||
|
|||
Change Font Italic or normal from one point
Good Morning and happy New Year from Switzerland.
I created a simple macro to adapt some caracters in a Word text. I stopped at the point were I cannot find a solution : In a line, I have a sentence like: "Title and subtitle at the date of 31.12.2019" I wanted to adapt the Font in Bold and Italic from the left of "at the date of" and in normal caracters to the right for "at the date of 31.12.2019" and finally delete "at the date" Then at the end I will have : "Title and subtitle of 31.12.2019" Many thanks for your help and nice regards |
#2
|
|||
|
|||
How about
Code:
Sub DeleteBoldItalics() Selection.HomeKey Unit:=wdStory With Selection.Find .ClearFormatting .MatchWildcards = True .Text = "Title and subtitle at the date of [0-9]{2,}.[0-9]{2,}.[0-9]{4,}" .Execute .Text = "Title and subtitle at the date" .Replacement.Text = "Title and subtitle" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With With Selection.Find.Replacement.Font .Bold = True .Italic = True End With With Selection.Find .Text = "Title and subtitle" .Replacement.Text = "Title and subtitle" .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With End Sub |
#3
|
|||
|
|||
Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oRng As Range Dim arrParts() As String Set oRng = Selection.Range With oRng arrParts() = Split(.Text, " at the date of") .Text = arrParts(0) .Font.Bold = True .Font.Italic = True .Collapse wdCollapseEnd .Text = arrParts(1) .Font.Bold = False .Font.Italic = False End With lbl_Exit: Exit Sub End Sub |
#4
|
|||
|
|||
Or an adaptation of Jeffrey's code:
Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oRng As Range Dim arrParts() As String Set oRng = ActiveDocument.Range With oRng.Find .Text = "Title and subtitle at the date of [0-9]{2,}.[0-9]{2,}.[0-9]{4,}" .MatchWildcards = True While .Execute With oRng arrParts() = Split(.Text, " at the date of") .Text = arrParts(0) .Font.Bold = True .Font.Italic = True .Collapse wdCollapseEnd .Text = arrParts(1) .Font.Bold = False .Font.Italic = False .Collapse wdCollapseEnd End With Wend End With lbl_Exit: Exit Sub End Sub |
#5
|
|||
|
|||
Thanks Greg. Learning something new everyday. Thanks for making those edits.
|
#6
|
|||
|
|||
Jeffrey,
Not implying my method was any better, I just like tinkering with arrays. Actually, since you are using a replace all, it would in all likelihood be faster in documents with lots of instances of the found text. |
#7
|
|||
|
|||
Hi Greg,
Quote:
|
#8
|
|||
|
|||
Change Font Italic or normal from one point
Thanks Jeffrey and Greg.
Sorry but I forgot that "Title and subtitle" is changing for each word file. What is always there is "at the date of". Then the reference for the macro should Always start from this "as the date of". Is that possible. In the meantime many thanks to aswer so quickly at my post and nice regards. Pierre |
#9
|
|||
|
|||
Hi Pierre,
Maybe Code:
Sub AtTheDateOf() Dim oRng As Range Dim arrParts() As String With Selection .HomeKey Unit:=wdStory .Find.Execute FindText:="at the date of [0-9]{2,}.[0-9]{2,}.[0-9]{4,}" .Expand wdParagraph Set oRng = .Range End With With oRng arrParts() = Split(.Text, " at the date") .Text = arrParts(0) .Font.Bold = True .Font.Italic = True .Collapse wdCollapseEnd .Text = arrParts(1) .Font.Bold = False .Font.Italic = False End With lbl_Exit: Exit Sub End Sub |
#10
|
|||
|
|||
Change Font Italic or normal from one point
Many thanks Jeffrey.
I tested today but the macro is blocking under: .Text = arrParts(1) and I have to debug Sub AtTheDateOf() Dim oRng As Range Dim arrParts() As String With Selection .HomeKey Unit:=wdStory .Find.Execute FindText:="at the date of [0-9]{2,}.[0-9]{2,}.[0-9]{4,}" .Expand wdParagraph Set oRng = .Range End With With oRng arrParts() = Split(.Text, " at the date") .Text = arrParts(0) .Font.Bold = True .Font.Italic = True .Collapse wdCollapseEnd .Text = arrParts(1) .Font.Bold = False .Font.Italic = False End With lbl_Exit: Exit Sub End Sub Here the text I want to adapt each time: MRI Brain at the date of 10.01.2020 should be written: MRI Brain : in Italic and Bold (left side of "at the date of") 10.01.2020 : in normal caracters (right size of "at the date of") But this Title "MRI Brain is changing and the date as well . Nice regards and many thanks for your help |
#11
|
|||
|
|||
Hi Pierre,
Maybe you can attach a sample file so we can work on your exact sample. |
#12
|
|||
|
|||
If the text " at the date of" contains a non-breaking space or isn't exactly as defined in the code then there will be no element (1) of the array.
|
#13
|
|||
|
|||
Change Font Italic or normal from one point
Quote:
I joined a sample of text. what you should know is that the text: Radiographies et IRM du pied gauche et du pied droit in the date of 23.09.2019 is never the same in all my word file. the only words that are Always present is : "in the date of" Nice regards and thanks again . Pierre |
#14
|
|||
|
|||
Hi Pierre,
I'm not sure here either as this so maybe Greg can post a good solution. |
#15
|
|||
|
|||
You are never going to get anything to work if you are going to continue to move the goal posts!!! The text "in the date of" is not present in the sample document you sent. In addition, that document has content controls so the search string used previously just isn't going to work.
Try this: Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oRng As Range Dim oRngP As Range Dim arrParts() As String Set oRng = ActiveDocument.Range With oRng.Find .Text = " né(e) le " While .Execute With oRng Set oRngP = oRng.Duplicate oRngP.Expand wdParagraph oRngP.End = oRng.Start With oRngP .Font.Bold = True .Font.Italic = True End With oRng.Collapse wdCollapseEnd End With Wend End With lbl_Exit: Exit Sub End Sub |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
PowerPoint macro to change words between quotes to italic needed | KarenK13 | PowerPoint | 9 | 01-12-2020 12:59 PM |
Font will not lose Italic. Corruption? | Ulodesk | Word | 2 | 07-25-2016 06:01 AM |
Opening doc in Word 2010 causes normal template to change - font size incorrect | Simonb | Word | 4 | 01-26-2016 03:52 PM |
Help with drop down menu changing Italic font when unlinked | brent chadwick | Word VBA | 3 | 11-24-2015 12:48 PM |
Change font & point size? | markg2 | Outlook | 2 | 06-09-2010 03:23 PM |