#1
|
||||
|
||||
VBA Word - Find & Apply Styles to Specific Words - Using Case Statement
Hi,
greetings to all on the forum this day / evening. I am trying to apply the CASE in VBA to some words that need styling. I have a document that has specific words which each need to have a different style applied to them. I thought the case statement would be the best approach? So for example - specific words in the document will have an identifier in front of them we will use the hash # and a number. #1apples #3pears #4grapes Word has in front | Apply Style =============================== #1 | Strong #2 | Heading 1 #3 | Character Style 1 #4 | italic #5 | Character Style 2 ================================= I then need to find these words and then apply the correct style to the word. I'm not sure if an if else or a case would be the best. I have been using individual macros to plod along, but its really inefficient - I have to call 10 macros on one document, and then I have 50 documents to go through, I'm starting to forget which one I applied where. My non working version and attempt - Code:
Sub FindAndApplyStyles() 'Find Words in Document - Apply Style Set Range = Selection.Range Dim rng As Range For Each rng In Range.Words Set rngStyle = rng.Style Select Case rangeStyle Case "Strong" Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Style = ActiveDocument.Styles("Strong") With Selection.Find .Text = "(#)[1][A-z]{1,}" ' Find the # sign followed by a number 1 > followed by any characters A-Z at least once .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll Case "Italic" Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Style = ActiveDocument.Styles("italic") With Selection.Find .Text = "(#)[4][A-z]{1,}" ' Find the # sign followed by a number 4 > followed by any charcters A-Z at least once .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll Some more Cases.........etc Case Else do nothing End Select Next rng End Sub I would really appreciate the help. As always thank you so much in advance for the time taken to look over this problem. J |
#2
|
||||
|
||||
You could use a macro like:
Code:
Sub Demo() Application.ScreenUpdating = False Dim StrFnd As String, StrSty As String, i As Long StrFnd = "1,2,3,4,5" StrSty = " Strong,Heading 1,Character Style 1,Italic,Character Style 2" With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .Wrap = wdFindContinue .MatchWildcards = True For i = 0 To UBound(Split(StrFnd, ",")) .Text = "#" & Split(StrFnd, ",")(i) & "[A-Za-z]@>" .Replacement.Style = Split(StrSty, ",")(i) .Execute Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
||||
|
||||
Hi Paul,
thank you for responding. Yipee! The awesome magic is working! Very Elegant - thank you! I was really struggling managing and running that many macros. Always misplacing them from document to document. This way I can easily edit the styles needed per set of document templates and bulk replace all the words in one go and streamline everything. I am really grateful for this macro. One major less stress. I also wanted to explain the reason why I thought I may use the VBA case situation. I am going to adapt this macro to help me insert placeholders later, to the text we have just styled. The reason I didn't state this earlier is because one set of documents just need this as it is - so this is perfect. Later I will create a copy of this set of documents and insert placeholders. I really hope you don't think its an imposition - which it is - but I've been fiddling about all morning hoping to showcase my adaptation - nothing works If you wouldn't mind helping me adapt this macro - the final piece of the puzzle. Or if I open a new thread the title would be - Find Style - Apply Placeholder before and after each style. Code:
Sub InsertPlaceholders() 'Find a Style - Apply Placeholder before and after Application.ScreenUpdating = False Dim StrFnd As String, StrSty As String, i As Long StrStyleFind = "Strong,italic,Heading 1,Heading 2,Heading 3" With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .Wrap = wdFindContinue .MatchWildcards = True Case (Strong) Selection.Find.Style = ActiveDocument.Styles("Strong") Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .Replacement.Text = "Placeholder1^& Placeholder2" Case (Italic) Selection.Find.Style = ActiveDocument.Styles("italic") Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "" .Replacement.Text = "Placeholder3^& Placeholder4" .Execute Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True End Sub Your coding eyes and expertise really appreciated. As always forever grateful thank you J |
#4
|
||||
|
||||
You could just extend the model I've already provided:
Code:
Sub Demo() Application.ScreenUpdating = False Dim StrFnd As String, StrSty As String, StrRep As String, i As Long StrFnd = "1,2,3,4,5" StrSty = " Strong,Heading 1,Character Style 1,Italic,Character Style 2" StrRep = "Placeholder1^& Placeholder2,^&,^&,Placeholder3^& Placeholder4,^&" With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .Wrap = wdFindContinue .MatchWildcards = True For i = 0 To UBound(Split(StrFnd, ",")) .Text = "#" & Split(StrFnd, ",")(i) & "[A-Za-z]@>" .Replacement.Style = Split(StrSty, ",")(i) .Replacement.Text = Split(StrRep, ",")(i) .Execute Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
||||
|
||||
Hi Paul,
hope you are doing great! thank you so much for helping again. I get this error Error 5834 .Replacement.Style = Split(StrSty, ",")(i) After I stop the debug, then it inserts the placeholders for style strong, but nothing for heading 1. In the second set of documents I was going to remove all the #hash identifiers, so we wouldn't even need to search for the #identifiers second time round - if that's easier. .Text = "#" & Split(StrFnd, ",")(i) & "[A-Za-z]@>" .Replacement.Style = Split(StrSty, ",")(i) So it would be Simply find the styles and insert before and after. StrStyleFind = " Strong,Heading 1,Character Style 1,Italic,Character Style 2" StrStyleRep = "Placeholder1^& Placeholder2,^&,^&,Placeholder3^& Placeholder4,^&" would that work? thank you J |
#6
|
||||
|
||||
Your 'Heading 1' problem isn't related to the code I posted, since 'Heading 1' is a standard Word Style - unless you're using templates designed for a language other than English.
Your Styles replacement approach would work, though the code I posted would do the lot in one pass.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
||||
|
||||
Hi Paul,
I am using standard heading 1. For some reason it does not work with the headings 1,2,3,4,5 I am using word 2016, It works with Strong , other styles that I created. It does not give an error with the headings replacement, just does not insert anything. I am not sure - what can I do to the headings. As far as I saw it was normal template J Last edited by jc491; 12-22-2015 at 09:27 AM. |
#8
|
||||
|
||||
The code in posts #2 & #4 works for me. Unless you've changed the code, the only other explanation would be that you don't have any text that conforms to the Find specification (e.g. #2A, #2a)
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
||||
|
||||
Hi Paul,
thanks for persevering with me. It's definitely my word 2016. Word can really infuriate me sometimes - #2 was working perfectly yesterday, now both of them give the .Replacement.Style = Split(StrSty, ",")(i) error. My normal template seems normal - no pun intended. I will do some Sherlock Holmes on it and see what I come up with. thank you J |
#10
|
||||
|
||||
Hi Paul,
its another 2016 problem - Had quite a few issues this year. #2 - gives an error - when I dismiss it and press the END BUTTON - it applies the styles any way. #4 - Same Thing - applies it only when I dismiss the error. I don't understand why it's playing up like this - maybe I need to add an on error resume somewhere? I guess I will have to live with it. I was going to run this macro on a folder full of files - I will see what happens. Apart from that thank you so much for all the coding help these past few months. You can understand my frustration with VBA - not the most graceful of programming languages. I have some absolute fantastic gems from you - that will make such a difference to my stress levels next year. I cant thank you enough again for helping all the newbies like me who present you with the most miss mashed chunks of code to grace your eyes. Often times out of desperation we are known to try and mix and match code blocks - as if you didn't know already. You can always spot the amateurs, we do try Microsoft doesn't make it any easier - some of the help materials online for VBA are hilariously sad - generous individuals such as yourself who have the patience to code VBA are a treasure and asset to the community! So thank you! I would be lost without all the help - banging away at the keyboard for days on end - as is my usual, with the will to live slipping away with every new iteration of a vba line that fails to make the grade! I hope you will have the most awesome Xmas holiday. Wishing you and everyone on this forum a happy holiday! And a wonderful 2016. J Cheers from across the pond! ****Double Solved Extra Stars If I can solve the problem of this mysterious error - I will update the thread in future - apart from that Solved PS - My 2015 has been great thanks to your help! |
#11
|
||||
|
||||
You might try repairing the Office installation (via Start > Windows Control Panel > Programs > Programs & Features > Microsoft Office (version) > Change > Repair).
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#12
|
||||
|
||||
Hi Paul,
thank you , I reset the 2016, however , I had an epiphany and oops, it had to be me that let down the mission to mars. I found the problem - embarrassingly the reason I had errors, is because I had the styles - that didn't exist - I forgot - that Character Style 1 and 2 were placeholders yikesss! As you can see hopelessly useless when it comes to VBA, I spent hours fiddling about yesterday. So both macros A+++++ working perfectly as is, I ran them on a folder full of docs - no problemo. Now the last problem I have - I will have to ask for your help again - otherwise I will be stuck from here to 2016. If I simply want to find the styles and insert the placeholders, which lines do I adapt? All the #signs have been removed as they served their purpose and have to be deleted from the documents. I simply want to find the styles and insert placeholders before and after each style Code:
StrStyFind = "Strong,Heading 1" StrRep = "Placeholder1 ^& Placeholder2 ,Placeholder3 ^& Placeholder4>" With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .Wrap = wdFindContinue .MatchWildcards = True For i = 0 To UBound(Split(StrFnd, ",")) .Text = Split(StrFnd, ",")(i) ' Stuck here .Replacement.Style = Split(StrSty, ",")(i) 'Stuck here .Replacement.Text = Split(StrRep, ",")(i) .Execute Replace:=wdReplaceAll Next thank you J |
#13
|
||||
|
||||
You could use:
Code:
Sub Demo() Application.ScreenUpdating = False Dim StrSty As String, StrRep As String, i As Long StrSty = " Strong,Heading 1,Character Style 1,Italic,Character Style 2" StrRep = "Placeholder1^& Placeholder2,^&,^&,Placeholder3^& Placeholder4,^&" With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .Wrap = wdFindContinue .MatchWildcards = True For i = 0 To UBound(Split(StrSty, ",")) .Style = Split(StrSty, ",")(i) .Replacement.Text = Split(StrRep, ",")(i) .Execute Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#14
|
||||
|
||||
Hello Paul,
thank you so much for helping me again for the zillionth time I run the code and here is what I get Code:
Sub PaulDemo() Application.ScreenUpdating = False Dim StrSty As String, StrRep As String, i As Long StrSty = " Strong, Heading 1" StrRep = "Placeholder1 ^& Placeholder2,Heading 1 ^& Heading2" With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = True .Wrap = wdFindContinue .MatchWildcards = True For i = 0 To UBound(Split(StrSty, ",")) .Style = Split(StrSty, ",")(i) .Replacement.Text = Split(StrRep, ",")(i) .Execute Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True End Sub forever grateful J |
#15
|
||||
|
||||
Try inserting:
.Text = "[!^13]{1,}" before, say: .Forward = True
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
apply style, case |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Apply styles in word table | 1van | Word VBA | 2 | 11-17-2015 11:05 AM |
VBA Word - Format ALL Tables - Apply Specific Formatting to Sets of Columns – Font, Border & Width | jc491 | Word VBA | 10 | 11-04-2015 04:02 PM |
Question about Case statement | Jennifer Murphy | Word VBA | 1 | 01-05-2013 02:30 PM |
Paragraph space before - can styles apply it intelligently? | timpani | Word | 7 | 10-23-2012 04:08 PM |
FInd recurring words in Word 2003 | NJ007 | Word | 4 | 01-25-2010 03:11 PM |