I need to do the following in a Word Macro.
I need to go through a Word document and change certain paragraphs based on their parameters. If the font size of a paragraph is 19.5, the paragraph must get style Heading 1. The next paragraph will be Heading 2, and the next after it -- Heading 3. The other text will remain to have style "Normal".
Wrote the following Macro:
Sub styles_temp()
' Declare a paragraph
Dim p As Paragraph
' Declare the current size.
Dim currentSize As Single
'Iterate through the text and print each paragraph
For Each p In ActiveDocument.Paragraphs
' Determine current size of the paragraph
currentSize = p.Range.Font.Size
' If size is 19.5, it will be Heading 1
If currentSize = 19.5 Then
p.Range.Style = ActiveDocument.Styles("Heading 1")
' Next Line is Heading 2
p.Next.Range.Style = ActiveDocument.Styles("Heading 2")
ElseIf p.Range.Style = "Heading 2" Then
p.Next.Range.Style = ActiveDocument.Styles("Heading 3")
End If
Next p
End Sub
The problem is that sometimes the text contains a paragraph and sometimes just a new line. Trying to figure out to replace all new lines with paragraphs. Would appreciate any help.
Thank you!
It sounds like you mean the entire document: "replace all new lines with paragraphs"
ActiveDocument.Content.Find.Execute FindTExt:="^l", ReplaceWith:="^p", Replace:=wdReplaceAll
Note: Your code is using ActiveDocument a lot. It would be more efficient and safer to assign this to a variable:
Dim doc as Word.Document
Set doc = ActiveDocument
doc.Content.Find.Execute FindTExt:="^l", ReplaceWith:="^p", Replace:=wdReplaceAll
Related
I am attempting to create a macro in Word that alters the style of a set of ~150 unique headings. All styles must be identical. My current code works and changes the formatting correctly, but only one heading at a time.
Simply put, it's ugly.
I'm looking for something I can reuse, and possibly apply to more projects in the future.
Maybe using the loop command? I don't know, I'm still somewhat new using VBA.
Sub QOS_Headings()
Dim objDoc As Document
Dim head1 As Style, head2 As Style, head3 As Style, head4 As Style
Set objDoc = ActiveDocument
Set head1 = ActiveDocument.Styles("Heading 1")
Set head2 = ActiveDocument.Styles("Heading 2")
With objDoc.Content.Find
.ClearFormatting
.Text = "Section A.^p"
With .Replacement
.ClearFormatting
.Style = head1
End With
.Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
End With
End Sub
If there is no way in which you can identify the heads you want automatically you may have to write everything once. Create a separate function for this purpose. It might look like this:-
Private Function SearchCriteria() As String()
Dim Fun(6) As String ' Fun = Designated Function return value
' The number of elements in the Dim statement must be equal to
' the number of elements actually declared:
' observe that the actual number of elements is one greater
' than the index because the latter starts at 0
Fun(0) = "Text 1"
Fun(1) = "Text 2"
Fun(2) = "Text 3"
Fun(3) = "Text 4"
Fun(4) = "Text 5"
Fun(5) = "Text 6"
Fun(6) = "Text 7"
SearchCriteria = Fun
End Function
You can add as many elements as you wish. In theory it is enough if they are unique within the document. I shall add some practical concerns below. Use the code below to test the above function.
Private Sub TestSearchCriteria()
Dim Crits() As String
Dim i As Long
Crits = SearchCriteria
For i = 0 To UBound(Crits)
' prints to the Immediate Window:
' select from View tab or press Ctl+G
Debug.Print Crits(i)
Next i
End Sub
Now you are ready to try to actually work on your document. Here is the code. It will not effect any changes. It's just the infrastructure for testing and getting ready.
Sub ChangeTextFormat()
Dim Crits() As String
Dim Rng As Range
Dim Fnd As Boolean
Dim i As Long
Crits = SearchCriteria
For i = 0 To UBound(Crits)
' find the Text in the document
Set Rng = ActiveDocument.Content
With Rng.Find
.ClearFormatting
.Execute FindText:=Crits(i), Forward:=True, _
Format:=False, Wrap:=wdFindStop
Fnd = .Found
End With
If Fnd = True Then
With Rng
Debug.Print .Text
' .MoveStart wdWord, -2
' With .Font
' .Italic = True
' .Bold = True
' End With
End With
Else
Debug.Print "Didn't find " & Crits(i)
End If
Next i
End Sub
The first half of the procedure will find each of the search criteria in your document using the same kind of loop as you already know from the test procedure. But now the text is fed to the Find method which assigns the found text to the Rng range. If the item is found you now have a handle on it by the name of Rng.
The second half of the sub deals with the outcome of the search. If the text was found the found text (that is Rng.Text) is printed to the Immediate window, otherwise the original text Crits(i) with "didn't find".
If the text was found you want to assign a style to it. But before you can do so you should deal with the difference between the text you found and the text you want to format. This difference could be physical, like you didn't write the entire length of the text in the criteria, or technical, like excluding paragraph marks. In my above sub there is just random code (extending the Rng by two preceding words and formatting everything as bold italics). Consider this code a placeholder.
For your purposes code like this might do the job, perhaps. .Paragraphs(1).Style = Head1 Actually, that is rather a different question, and I urge you not to rush for this result too fast. The part you now have needs thorough testing first.
I have a 400+ page coding manual I use, and unfortunately turned off the green for all the comments in the manual. I can't undo it, as I hadn't noticed it until it was too late. Its ruined years of work.
How would I write VBA to parse the document finding sentences starting with // and ending in a Paragraph mark and change the color of them? Or assign a style to them?
Here is a start that I have cobbled together, I admire people who can write code without intellisence, its like trying to find your way blindfolded
Dim oPara As Word.Paragraph
Dim rng As Range
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
If Len(oPara.Range.text) > 1 Then
Set rng = ActiveDocument.Range(oPara.Range.Start,oPara.Range.End)
With rng.Font
.Font.Color = wdColorBlue
End With
End If
Next
End Sub
The following seems to work:
Dim oPara As Word.Paragraph
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
text = oPara.Range.text
'Check the left 2 characters for //
If Left(oPara.Range.text, 2) = "//" Then
oPara.Range.text = "'" & text
End If
Next
I assume you are using VBA so by placing a ' in front of // it will turn the line green. You could modify the code to replace // with ' if desired. The opera.range.text should grab the entire paragraph.
I shamelessly recorded a macro to amend the default heading styles 2 - 5 to change their .NextParagraphStyle to ones of my own making called Normal_lvl2, Normal_lvl3 etc :
With ActiveDocument.Styles("Heading 2").ParagraphFormat ' etc etc
.LeftIndent = CentimetersToPoints(1.13)
.RightIndent = CentimetersToPoints(0)
.LineSpacingRule = wdLineSpaceDouble
.Alignment = wdAlignParagraphLeft
.FirstLineIndent = CentimetersToPoints(-0.63)
.OutlineLevel = wdOutlineLevel2
.NoSpaceBetweenParagraphsOfSameStyle = False
.AutomaticallyUpdate = True
.BaseStyle = "Normal"
.NextParagraphStyle = "Normal_lvl2" ' here is the next style
End With
Problem is the document doesn't actually update the next paragraph style, either when I run the macro or set a style for a line manually. The new style works fine for the actual header line but the next paragraph is not changed.
I did try to loop through all paragraphs and set the style but it took far too long (I quit after 20 mins run time, the doc is 160 pages). Specifically I got all headings into an array, used Find to return a range for each of the headers in the array and set the next range style depending on the heading level. Maybe not the best way but I'm not too familiar with the Word Object Model.
So my question is - is there an efficient way to automate the application of my custom styles and to ensure the next paragraph style is also changed?
You should iterate over all paragraphs in your document and then adjust the following paragraph accordingly like it is done in the following sample:
Sub ChangeParagraphsAfterHeading()
Dim para As Paragraph
Dim nextPara As Paragraph
For Each para In ActiveDocument.Paragraphs
If para.Style = "Heading 2" Then
Set nextPara = para.Next
If Not nextPara Is Nothing Then
nextPara.Style = "Normal_lvl2"
End If
End If
Next
End Sub
I assume that you probably want to adjust the style for all paragraphs between two headings. The sample above doesn't do that yet, but it should get you started.
I'm basically trying to create a cumulative word count for documents that will put the number of words on each page into its footer and add it to the total words each page. After a lot of looking around, I found that Word doesn't really handle pages the same for everybody and so doesn't have any interface to access the individual pages through.
Now I'm trying to separate each page with page breaks so there's a clear delimiter between pages, but I still can't find how to loop through these. Any clues?
I'm going to post the code I have, but it's only for getting the word count currently. No proper attempts at cycling through page breaks because I don't know how.
Sub getPageWordCount()
Dim iPgNum As Integer
Dim sPgNum As String
Dim ascChar As Integer
Dim rngPage As Range
Dim iBeginPage As Integer
Dim iEndPage As Integer
' Go to start of document and make sure its paginated correctly.
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
ActiveDocument.Repaginate
' Loop through the number of pages in the document.
For iPgNum = 2 To Selection.Information(wdNumberOfPagesInDocument)
sPgNum = CStr(iPgNum)
iBeginPage = Selection.Start
' Go to next page
Selection.GoTo wdGoToPage, wdGoToAbsolute, sPgNum
' and to the last character of the previous page...
Selection.MoveLeft wdCharacter, 1, wdMove
iEndPage = Selection.Start
' Retrieve the character code at insertion point.
Set rngPage = ActiveDocument.Range(iBeginPage, iEndPage)
MsgBox rngPage.ComputeStatistics(wdStatisticWords)
'rngPage.Footers(wdHeaderFooterPrimary).Range.Text = rngPage.ComputeStatistics(wdStatisticWords)
'ActiveDocument.Sections(2).Footers
' Check the character code for hard page break or text.
Next
' ActiveDocument.Sections(2).Footers(wdHeaderFooterPrimary).Range.Text = "bob" 'Testing
End Sub
Finally got it, managed to guess my way through it a bit, taking assorted bits from dark corners of the internet:
Sub getPageWordCount()
'Replace all page breaks with section breaks
Dim myrange1 As Range, myrangedup As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:="^m", Forward:=True, _
MatchWildcards:=False, Wrap:=wdFindStop) = True
Set myrange = Selection.Range
Set myrangedup = Selection.Range.Duplicate
myrange.Collapse wdCollapseEnd
myrange.InsertBreak wdSectionBreakNextPage
myrangedup.Delete
Loop
End With
'Unlink all footers and insert word count for each section
Dim sectionCount, sectionNumber, i, sectionWordCount, cumulativeWordCount As Integer
sectionCount = ActiveDocument.Sections.Count
For sectionNumber = 1 To sectionCount
With ActiveDocument.Sections(sectionNumber)
sectionWordCount = .Range.ComputeStatistics(wdStatisticWords)
cumulativeWordCount = cumulativeWordCount + sectionWordCount
With .Footers.Item(1)
.LinkToPrevious = False
.Range.Text = "This page's word count: " + CStr(sectionWordCount) + " | Cumulative word count: " + CStr(cumulativeWordCount)
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
End With
Next
End Sub
And now I've just discovered that if I want to port this macro to an add-in for ease of use for non-techy users I have to write it in VB 2010 in Visual Studio where the API is different. Good luck me!
It sounds as if you have what you need, but I was working on an alternative that I may as well post because it does not require you to add page breaks or section breaks. But you would have to add the same nested field in each footer that appears in the document (I haven't done that part here, but it's not completely trivial because there may be multiple sections and multiple footers per section).
The field code you need to add (in addition to your 'This page's word count: ' text) is
{ DOCVARIABLE "s{ SECTION }p{ PAGE \*arabic }" }
As written, the method may break in some circumstances, e.g. if there are continuous section breaks. I haven't checked.
Sub createWordCounts()
Dim i As Integer
Dim rng As Word.Range
With ActiveDocument
For i = 1 To .Range.Information(wdActiveEndPageNumber)
Set rng = .GoTo(wdGoToPage, wdGoToAbsolute, i).Bookmarks("\page").Range
.Variables("s" & CStr(rng.Information(wdActiveEndSectionNumber)) & "p" & CStr(rng.Information(wdActiveEndAdjustedPageNumber))).Value = rng.ComputeStatistics(wdStatisticWords)
Set rng = Nothing
Next
End With
End Sub
i have a document that i'm reviewing with yellow highlighted text. i want a macro to go through and remove the lines that are highlighted. so far this is what i have:
Sub hilight()
'
' hilight Macro
' removes lines in yellow hi-lighter
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
Dim holder As String
If p.Range.Text = highlighted_text Then
p.Range.Text = holder
End If
Next p
End Sub
i need to know how highlighted text property is given so i can replace highlighted_text
Here is a solution. Note that it only replaces paragraphs in which the entire paragraph is yellow highlighted, not just part of it. There are a few things worth pointing out:
Replacing a paragraph will also take out the trailing line break, so I include it in the placeholder text
Since a line break is being added, if you don't loop through the paragraphs backwards, it'll be an infinite loop (thus the step -1)
Dim all variables outside of a loop
Sub ReplaceYellowParagrahps()
Dim p As Paragraph
Dim i As Long, count As Long
Dim placeholderText As String
placeholderText = "holder" & vblf
count = ActiveDocument.Paragraphs.count
For i = count To 1 Step -1
With ActiveDocument.Paragraphs(i).Range
If .HighlightColorIndex = wdYellow Then
.Text = placeholderText
End If
End With
Next
End Sub