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
Related
Goal: Find headings in a document by their font and font size and put them into a spreadsheet.
All headings in my doc are formatted as Ariel, size 16. I want to do a find of the Word doc, select the matching range of text to the end of the line, then assign it to a variable so I can put it in a spreadsheet. I can do an advanced find and search for the font/size successfully, but can't get it to select the range of text or assign it to a variable.
Tried modifying the below from http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldn't figure out how to select and assign the found text to a variable. If I can get it assigned to the variable then I can take care of the rest to get it into a spreadsheet.
'A basic Word macro coded by Greg Maxey
Sub FindFont
Dim strHeading as string
Dim oChr As Range
For Each oChr In ActiveDocument.Range.Characters
If oChr.Font.Name = "Ariel" And oChr.Font.Size = "16" Then
strHeading = .selected
Next
lbl_Exit:
Exit Sub
End Sub
To get the current code working, you just need to amend strHeading = .selected to something like strHeading = strHeading & oChr & vbNewLine. You'll also need to add an End If statement after that line and probably amend "Ariel" to "Arial".
I think a better way to do this would be to use Word's Find method. Depending on how you are going to be inserting the data into the spreadsheet, you may also prefer to put each header that you find in a collection instead of a string, although you could easily delimit the string and then split it before transferring the data into the spreadsheet.
Just to give you some more ideas, I've put some sample code below.
Sub Demo()
Dim Find As Find
Dim Result As Collection
Set Find = ActiveDocument.Range.Find
With Find
.Font.Name = "Arial"
.Font.Size = 16
End With
Set Result = Execute(Find)
If Result.Count = 0 Then
MsgBox "No match found"
Exit Sub
Else
TransferToExcel Result
End If
End Sub
Function Execute(Find As Find) As Collection
Set Execute = New Collection
Do While Find.Execute
Execute.Add Find.Parent.Text
Loop
End Function
Sub TransferToExcel(Data As Collection)
Dim i As Long
With CreateObject("Excel.Application")
With .Workbooks.Add
With .Sheets(1)
For i = 1 To Data.Count
.Cells(i, 1) = Data(i)
Next
End With
End With
.Visible = True
End With
End Sub
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
In my docs I use either Arial or Courier New (for code) and sometimes both in the same paragraph. As I share my docs with other people, they tend to use other fonts as well but it is important to keep it aligned, that;s why I am trying to create a macro that will turn all non-Courier New text into Arial and into the correct font size (11).
I face 2 problems with what I have achieved so far:
In paragraphs with mixed fonts it tends to change the whole paragraph (including the code) to Arial, while i need it to change only the non-code text
It changes the font size not only in the body text but in the headings as well.
I think I'm using incorrectly the objects of Word (I'm used in working in Excel) but I can't find anywhere online any clues. Can anyone help me please?
Sub CorrectFont()
Dim p As paragraph
Set p = ActiveDocument.Paragraphs(1)
Application.Visible = False
Application.ScreenUpdating = False
Do
If p.Range.Font.Name <> "Courier New" Then
p.Range.Font.Name = "Arial"
p.Range.Font.Size = 11
End If
Set p = p.Next
Loop Until p Is Nothing
Application.ScreenUpdating = True
Application.Visible = True
End Sub
You can check each individual word, like so:
' Replaces non-Arial fonts with Arial.
' Exception: Courier New is not replaced.
Sub AlignFont()
Dim wd As Range
' Check each word, one at a time.
For Each wd In ActiveDocument.Words
If Not (wd.Font.Name = "Arial" Or wd.Font.Name = "Courier New") Then
wd.Font.Name = "Arial"
End If
Next
End Sub
Thanks to #destination-data 's inputs I reached a final form of the code. I present it here for anyone that might be interested.
Thank you again!
Sub AlignFont()
Dim wd As Range
Application.Visible = False
Application.ScreenUpdating = False
' Check each word, one at a time.
For Each wd In ActiveDocument.Words
'On objects like Contents it may create an error and crash
On Error Resume Next
If wd.Font.Name <> "Courier New" And wd.Style = "Normal" Then
wd.Font.Name = "Arial"
End If
'To avoid any header that may have a "Normal" style
If wd.Font.Bold = False Then
wd.Font.Size = 11
End If
Next
Application.ScreenUpdating = True
Application.Visible = True
End Sub
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 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.