Word 2013 VB script to loop through document and change styles - vba

I need a script which iterates through a word document and changes the style of paragraphs following a Headline style or an Image to a custom style without first line indent.
How do I loop through the paragraphs/headers/items in a word document? And how do I get the style? And how do I set the style afterwards?
The Goal is simple: I want the first line of a paragraph be indented, but not if the paragraph is following a Header line or image. And since this is a large document and I get those quite often I'd like some Kind of Automation and not try to do this by Hand.
So I'd like to write a script which is iterating through the paragraphs and changes the style from "paragraph" to "paragraph without indent" when it is after a header style or image.

Here is some basic code to get you started here. Unfortunately, the Paragraph.Style parameter doesn't distinguish between text and images, but you can check and see if a Paragraph.Range object has any InlineShapes, which are images.
Sub indentParas()
Dim doc As Document
Set doc = ActiveDocument
Dim para As Word.Paragraph
Dim i As Boolean
i = False
For Each para In doc.Paragraphs
If i = False Then
para.IndentCharWidth 4
End If
If para.Range.InlineShapes.Count > 0 Then
i = True
ElseIf Left(para.Style, 7) = "Heading" Then
i = True
Else
i = False
End If
Next
End Sub
Note: this is tested in Word 2010.

Related

How can i change every occurence of a specific font ind a Word document?

i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub

Is there a way to list broken internal hyperlinks with VBA in MS Word? (Hyperlink Subaddress)

In MS Word, you can create hyperlinks to a "Place in this document" so that a link takes you someplace else in the same Word file. However, if you change headers or move things around these links will sometimes break. I want to write some VBA to check for broken links.
With VBA, you can list each hyperlink subaddress using the code below:
Sub CheckLinks()
Set doc = ActiveDocument
Dim i
For i = 1 To doc.Hyperlinks.Count
Debug.Print doc.Hyperlinks(i).SubAddress
Next
End Sub
The output from the code above also matches what is shown in the field codes for the hyperlink.
However, I'm not really clear on how to verify if the SubAddress is correct. For example, an excerpt from the program output shows this:
_Find_a_Staff_1
_Edit_Organization_Settings_2
_Set_the_Staff
_Find_a_Staff_1
But there's no obvious way to tell what the "correct" suffix should be for a given heading. Any thoughts on how to check if these are valid?
Is there a way to get the list of all valid subaddresses for the headings in the document?
The code below will list the hyperlinks where the corresponding bookmark does not exist in the document. (Note that it only detects missing links, not links that go to the wrong place.)
Sub CheckLinks()
Dim doc As Document
Set doc = ActiveDocument
Dim i, j
Dim found As Boolean
For i = 1 To doc.Hyperlinks.Count
found = False
For j = 1 To doc.Bookmarks.Count
If doc.Range.Bookmarks(j).Name = doc.Hyperlinks(i).SubAddress Then
found = True
End If
Next
If found = False Then
Debug.Print doc.Hyperlinks(i).SubAddress
End If
Next
End Sub

Word VBA next paragraph style not updating

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.

How do I extract text formatted with certain styles from word document?

I have a very long and complex word document (200+ pages), and would like to extract all content formatted with a certain style, while skipping the rest of the document. It is easy if to do as long as you only need to find one style - but i'm looking for a solution that can extract various styles (ie all headings AND all text formatted as style2).
If you can manage to copy all the test to another document then run this then great, but here's a good start - this is how you can loop through and delete everything that is not of the style you want to keep.
You could do a few if statements instead to check each style, but using a string of all the ok styles and using instr is nice.
Sub DeleteUnwatedFormats()
Dim para As Paragraph
Dim okStyles As String
okStyles = "Normal, Heading1, Heading2" 'list up ok styles
For Each para In ActiveDocument.Paragraphs
If InStr(1, okStyles, para.Style) = 0 Then
para.Range.Delete
End If
Next
End Sub
I tried running the code given above but it deleted everything - I think that in the line:
If InStr(1, okStyles, para.Style) = 0 Then
okStyles and para.Style should be swapped around to give:
If InStr(1, para.Style, okStyles,) = 0 Then
When I did this it worked fine.

Update all styles in doc to left-align

I am looking for a macro for word documents that will find every style in a document, and change it from whatever it is (centered, justified, right-align) to left-align.
I don't want to change the text (except as a by-product), but the style itself so everything updates.
Thanks Remou, I tried working with it, and this seems to work:
Sub ChangeStyles()
Dim oSource As Document
Set oSource = ActiveDocument
For i = 1 To oSource.Styles.Count
' must check the style type as character style gives an error
If oSource.Styles(i).Type = wdStyleTypeParagraph Then
With ActiveDocument.Styles(i).ParagraphFormat
.Alignment = wdAlignParagraphLeft
End With
Else
End If
Next i
End Sub