I have a code that loops through the paragraphs of a document, and reapplies the heading style. This is in order to fix the numbering inconsistency after copy-pasting headings from different documents.
In my file I just have the following example:
For Each p In ThisDocument.Paragraphs
If p.Style = "Heading 1" Then
p.Style = "Heading 1"
End If
Next p
This solves the issue, but the problem is if somebody has Word running in a different language, "Heading 1" is not applicable anymore. I tried with wdstyleheading1 as well, but the p.Style always reads out the actual name of the style, not an enumeration.
I thought of p.Style.ListLevelNumber, but that seems to be too vague, and might mess up other lists in the document.
Is there a way to read or reference it in a language independent way?
Is there perhaps a better solution altogether for the numbering problem?
you can get the local name for a style with .NameLocal. It's kind of a workaround because I don't think you can actually compare a paragraphs .Style with the enum, but this should do the trick.
For Each p In ThisDocument.Paragraphs
If p.Style = ActiveDocument.Styles(wdStyleHeading1).NameLocal Then
p.Style = wdStyleHeading1
End If
Next p
As simple as:
For Each p In ThisDocument.Paragraphs
If p.Style = wdStyleHeading1 Then
p.Style = wdStyleHeading1
End If
Next p
That said, using Find/Replace is way faster than looping through all paragraphs.
Actually, if your style definitions are correct in the attached template, you don't even need a macro for this. All you need do is check the 'automatically update document styles' option, found under Developer|Document Template>Templates. With that set, all you need do is save, close, then re-open the document.
Otherwise, using Find/Replace for all 9 Heading Styles:
Sub SetHeadingLanguage()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
'Style enumerations run from -2 (wdStyleHeading1) to -10 (wdStyleHeading9)
For i = -2 To -10 Step -1
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Format = True
.Wrap = wdFindContinue
.Style = i
.Replacement.Style = i
.Execute Replace:=wdReplaceAll
End With
Next
End With
Application.ScreenUpdating = True
MsgBox "Done."
End Sub
Related
I have a document where I want to start start searching in section 3 to the end of the document and bold text based on my user-defined style since other styles used may contain the same word I don't want to bold - including the possibility of the Heading/section.
I do have VBA code that works by finding my user-defined style throughout the document and bolding it for one style match only. However, the .Style in the .find doesn't allow one to specify a wildcard style i.e. my user-defined style set of "Requirement1 thru Requirement9" which are based off the Heading1-9 style. I assume I'll have to create a for loop outside of the "with" that finds my user-defined style that is passed one at a time to bold the text to match one style at a time i.e Requirement1 thru Requirement9. Is there a better way? see code below.
The next issue is to focus the search of this text to bold to start in a particular section to the end of the document. For me, its section 3 to the end of the document or till it encounters another style defined as Appendix1 and stop. I do have user-defined styles Appendix1 thru Appendix9 that are also based off of Heading1-9. The reason to search on a style as a starting point is because these other sections before section3, or descriptive text in Section 3 and beyond may contain the word I'm trying to bold - which I don't want to do except when my particular user-defined style Requirment1-9 was applied that is used in section 3 and beyond. In trying to implement this part before doing the word searching and bolding part, I've been searching based on the "Heading1" style and when I found the third one, I know I'm in section 3. I can't use the VBA "sections" search since it includes all the subsections of a document which can vary from document to document and specifying sections.item(3) doesn't mean I'll get the third section of my document that corresponds to the third Heading1 style.
Since I'm not that adept at the various VBA sections,paragraphs,sentences, characters and everything else when applying the "range" either before, after, or both on any of these (never seems to work the way one expects. Even the VBA hint tools says one can do it, but runtime says error) I've started with the specifying the start/end of the whole activedocument.range. Then I perform a ".find" of the "Heading1" style in a for loop three times which does find them. I then try to assign the last Heading1 found range value as the start value to use in the next embedded "find" that will search and apply the bold to the "Requirement1" style. (May need to create a loop to search Requirement1-9 styles as stated above). To help me know where I'm at, I'm trying to dump via debug.print the range position, but it dumps the all whole document text to the debug window and not the integer value I thought I'd get. Whats the issue with doing this? I've even tried to use a selection.range and dump the retrieved text to the debug.print window without success. It makes it worse since the processing timing seems to run forever. The wdFindStop doesn't force the find to stop on the third find either.
So how to:
a). find and dump the range position to the debug window along with the text at this position. Both the number and text will tell me where I'm at.
c). How to assign the range position based on find of the third "Heading1" position in the document so that that the second "with" can search and apply the bolding to the text I want to bold.
d). How to do a wildcard search on the .Style user-defined Requirement1-9 style instead of having to create a for loop to search one at a time?
The following is the VBA code I have written.
Attribute VB_Name = "BoldMustShall2_M"
Option Explicit
Public Sub BoldMustShall2()
' If .Parent.Bold = True is used with wdReplaceall, the whole
' document is bolded even when the sentence doesn't have any of the words
' being searched for.
Dim myRange, rngSel As Range
Dim oDoc As Word.Document
Dim pos1, pos2 As Long
Dim numchars As Long
Set oDoc = ActiveDocument
Set rngSel = Selection.Range
Application.ScreenUpdating = False
'Set the starting Heading to search as Section 3
pos1 = oDoc.Range.Start
pos2 = oDoc.Range.End
Set myRange = oDoc.Range(Start:=pos1, End:=pos2)
'Another way is to find the "Heading1" style and set the range start to the third one found which is section 3.
'Counting Word sections can vary alot so its not the best way.
'The same would apply if Appendix1 style is used and assuming that requiremens start in the third one.
Debug.Print "My Start Range " + myRange
With myRange
.TextRetrievalMode.IncludeFieldCodes = False ' don't want to search fieldcodes for must/shall
.TextRetrievalMode.IncludeHiddenText = False ' don't want to search hiddentext for must/shall
' Get the range position for Heading1 style for section 3 of PRD.
Dim i As Integer
Dim ReqHDR As Range
Dim bFind As Boolean
With .Find
.ClearFormatting
.Forward = True
'.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.Style = "Heading1"
'Loop three times for Style
For i = 1 To 3 Step 1
'bFind = .Execute
.Execute Wrap:=wdFindStop
If .Found = True Then
rngSel = oDoc.Range 'This should be the current position in the Document for the requirements.
' When found it outputs the message once
Debug.Print "Found a Heading1 style "
.Replacement.Font.Size = 20
End If
'.Wrap = wdFindStop
Next i
End With
Debug.Print "End of Heading1 Search "
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.Replacement.Font.Bold = True
.Replacement.Font.Name = "Times New Roman"
.Replacement.Font.Size = 12
.Replacement.Font.Italic = True
'.Style = "Requirement1" ' A loop is needed to cycle thru all the Requirement1-9 styles. No wildcard.
'.Style = wdStyleNormal
.Replacement.Text = "^&" ' This is the contents of the find what box in word.
' In this case the .find.text "must" statement.
' Alternate is to specify "must" or "shall" but this
' would require two replace.text statements instead of
' just this one. The ^& is a special command that eliminates
' the need to set the replacement.Text info.
'.Text = "must"
.Execute FindText:="must", Replace:=wdReplaceAll
If .Found = True Then
' When found it outputs the message once
Debug.Print "Found one or more must "
End If
'.Text = "shall"
.Execute FindText:="shall", Replace:=wdReplaceAll
If .Found = True Then
' When found it outputs the message once
Debug.Print "Found one or more shall "
End If
End With
End With
Application.ScreenUpdating = True
Debug.Print "Completed searching for must/shall in document."
End Sub
Assuming that, when you refer to 'Sections', you're referring to parts of your document delineated by Section breaks, perhaps something along the lines of:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, i As Long
With ActiveDocument
Set Rng = .Range(.Sections(3).Range.Start, .Range.End)
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Format = True
.Wrap = wdFindContinue
.Style = "Appendix1"
.Execute
End With
Rng.End = .Start
End With
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = True
.Replacement.Style = "Strong"
.Wrap = wdFindStop
.Replacement.Text = "^&"
.Text = "must"
For i = 1 To 9
.Style = "Requirement" & i
.Execute Replace:=wdReplaceAll
Next
.Text = "shall"
For i = 1 To 9
.Style = "Requirement" & i
.Execute Replace:=wdReplaceAll
Next
End With
End With
Application.ScreenUpdating = True
End Sub
Note that, instead of using hard formatting for the replacement, I've simply applied Word's built-in 'Strong' Style. Your own code should use a Style, too, whether it's Word's 'Strong' Style or another character Style of your own definition.
I was asked by a colleague if I could write a word macro to help them out; they use a service that dumps several newspaper articles into one word file without any headings and they'd like to create a TOC.
I said 'Absolutely not' because I don't have any experience writing word macros. However, I found with a little bit of googling I could create the following
Sub CreateHeadings()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "[0-9]# Wörter"
.Replacement.Text = ""
.Replacement.Style = "Heading 2"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "([0-9])(l[!a-z])"
.Replacement.Text = "\1^s\2"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub
which almost does what I want. However, I'd need to replace the bolded lines that would appear before my search pattern, so for example something like
Some Author; "Title"
maybe an additional line
565 Wörter
would have to be replaced with the same text, but where the bolded part is formatted to be a heading.
Is there an easy way to do that? Or should I just read up on vba first to fully understand what I'm doing here?
Update: I cleaned up unneeded parts and tried to incorporate helpful advice from Timothy Rylatt.
Sub CreateHeadings()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.Bold = True
.Format = True
With oRng.Find
.Text = "[0-9]# Wörter"
End With
.Replacement.Style = "Heading 2"
.Execute Replace:=wdReplaceAll
End With
End Sub
This doesn't do anything right now. I hope I'll understand some of the vba syntax soon so I can update this post with working code for others who might be interested in something like this.
You're already pretty much there so I'm not going to give a full answer.
As you've already figured out how to use wildcards and replace with a specific style all you need is how to find bold text.
With oRng.Find
.Font.Bold = True
.Format = True
this is my first post in this forum and I am also doing my first steps in word VBA, so please be patient with a poor latin teacher.
This is what I want to do:
In my active document I select a text with several words (or parts of words) formatted red. These words are the correct solutions for a CLOZE question (fill in the blank). Here is an example (red = bold):
Galli ad oppidum venerunt.
Caesar Q. Pedium legatum in Galliam misit.
This should become:
Romani ad oppidum (veniunt) {1:SHORTANSWER:=venerunt}.
Caesar Q. Pedium legatum in Galliam (mittit) {1:SHORTANSWER:=misit}.
So what I have to do is:
Find all red text snippets,
Foreach found red textsnippet insertBefore "{1:SHORTANSWER:=}" and insertAfter "}".
I tried to work with Selection.Find.Font.Color = wdColorRed, but then, how do I get hold of each 'instance' and how do I loop through it? The Find-Object has a property Text, but that is always empty :-(
Can you help me please?
Kind regards
Thomasina
For example:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Font.ColorIndex = wdRed
.Format = True
.Forward = True
.Wrap = wdFindStop
End With
Do While .Find.Execute
.InsertBefore "{1:SHORTANSWER:="
.Collapse wdCollapseEnd
.Text = "}"
.Font.ColorIndex = wdAuto
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
It's not apparent where '(veniunt)' and '(mittit)' are supposed to come from, however.
It's also not clear whether the F/R is supposed to insert the paragraph breaks.
I have a Find/Execute routine that looks for paragraphs in my custom style, Bullet_Type_1_Level_1, which is a custom bulleted list style, and processes the paragraphs. (It checks each paragraph in the given range to see if it terminates in a period or not, but that's not important for this question). The routine currently works fine, but I want to expand it to search for additional levels--which translates into additional styles--of my outline list and to search for a style in another list, too. Is there a compact way to have my code also look for paragraphs in Bullet_Type_1_Level_2 and numlist_Level_1 (and process them, too) while it's at it? Here's the guts of my existing code:
For Each para In RangeToCheck.Paragraphs
With Selection.Find
.Text = ""
.Style = "Bullet_Type_1_Level_1"
.Wrap = wdFindStop
.Execute
Do While .Found = True 'Look for the specified style
strSentence = Selection.Text
'Test the string using a block of code that I'm omitting, for brevity.
'Finally, depending on what happened, put or don't a period at the end of the original range.
End With
Next para
You can add another loop.
Declare i (or more meaningful variable name), and loop through that.
Dim i As Long
For Each para In RangeToCheck.Paragraphs
For i = 1 To 3
With Selection.Find
.Text = ""
Select Case i
Case 1
.Style = "Bullet_Type_1_Level_1"
Case 2
.Style = "Bullet_Type_1_Level_2"
Case 3
.Style = "numlist_Level_1"
End Select
.Wrap = wdFindStop
.Execute
Do While .Found = True 'Look for the specified style
strSentence = Selection.Text
'Test the string using a block of code that I'm omitting, for brevity.
'Finally, depending on what happened, put or don't a period at the end of the original range.
End With
Next i
Next para
Probably not the prettiest solution out there - word is not my strong point ☺.
An alternative approach that may be quicker if there are paragraphs that are none of those Styles:
Dim i As Long
For i = 1 To 3
With RangeToCheck
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Format = True
.Wrap = wdFindStop
.Style = "Bullet_Type_1_Level_" & i
.Execute
End With
Do While .Find.Found = True
If .InRange(RangeToCheck) = False Then Exit Do
Select Case i
Case 1 'Do something for Bullet_Type_1_Level_1
Case 2 'Do something for Bullet_Type_1_Level_2
Case 3 'Do something for Bullet_Type_1_Level_3
End Select
If ActiveDocument.Range.End = RangeToCheck.Range.End Then Exit Do
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
I have a Word document which contains of lot of styles; in that I want to select particular style and make starting numbers alone bold in all the paragraph style
eg:
1. first numbers alone
23. first number alone
This is my code
Sub ParaStyle()
Selection.HomeKey wdStory
Dim i As Integer
i = 1
Do Until i = Application.ActiveDocument.Paragraphs.Count
If Selection.ParagraphFormat.Style = "heading3" Then
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("heading3")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "([0-9]{1,2})"
.Replacement.Text = "\1"
'.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
.Execute Replace:=wdReplaceOne
End With
End If
i = i + 1
Loop
End Sub
Thanks in advance
You are running the search on the Selection, but you're not changing that selection between runs. So you just end up making the same text bold over and over again. Here's a way to do what you're doing without the Selection object:
Sub ParaStyle()
Dim objPara As Paragraph
For Each objPara In ActiveDocument.Paragraphs
If objPara.Style = "heading3" Then
With objPara.Range.find
.ClearFormatting
.Text = "([0-9]{1,2})"
.Style = ActiveDocument.Styles("heading3")
With .Replacement
.ClearFormatting
.Font.Bold = True
.Text = "\1"
End With
'.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
.Execute replace:=wdReplaceOne
End With
End If
Next objPara
End Sub
I didn't change much; instead of using a Do loop we loop through all the paragraphs in the document and work on each one. You can also use your code but make sure to do ActiveDocument.Paragraphs(i).Select before running the replace. I don't recommend that, as it's best to avoid using the Selection object when you can (one good reason to avoid it is that, if you have a script that takes a while and you try to do something else in a text editor, say, you'll run the risk of contaminating your clipboard).
Do keep in mind that there's nothing here to prevent this search from finding a number in the middle of the paragraph if there's none at the beginning. I'm assuming that narrowing it down by style is enough for you, or you wouldn't be using this approach.