Solved: reformat a zillion textboxes in a kerjillion documents

[The Tamer]

Hi,

I need some help re-formatting lots of documents. I'm hoping for a macro that will change all the text (including text in text-boxes and pictures) to Arial, 12 black.

Also, (a long shot) The first sentence in each textbox should be Title case.
I know how to do this manually, but the author of these documents has put almost everything in textboxes - it's driving me mad.

I have one day before I'm off to sunnier climbs - and have tons of docs to do.

Thanks, i love you all!!!

[Jacob Hilderbrand]

Can you attach one of the documents?

[The Tamer]

Not so many text boxes in this one...

[Jacob Hilderbrand]

Ok, I'll take a look. Also are all the docs you want to process in one folder or do we need to search through all sub folders as well?

[Jacob Hilderbrand]

Ok, Try this:


Option Explicit

Sub CleanUpDocs()

Dim i As Long
Dim TempText As String
Dim Shp As Shape
Dim Path As String
Dim Doc As Document
Dim FName As String
Dim AppWrd As New Word.Application

'This is the path of the folder to look in.
Path = "C:\Temp"

'Loop through all documents in the specified folder.
FName = Dir(Path & "\*.doc", vbNormal)
Do Until FName = ""
Set Doc = AppWrd.Documents.Open(FileName:=Path & "\" & FName)
Doc.Activate

'Modify the general text
Selection.WholeStory
With Selection.Font
.Color = wdColorBlack
.Size = 12
.Name = "Arial"
End With

'Loop through all shapes to modify TextBox text.
On Error Resume Next
For i = 1 To ActiveDocument.Shapes.Count
For Each Shp In ActiveDocument.Shapes(i).GroupItems
TempText = Shp.TextFrame.TextRange.Text
If Len(TempText) > 0 Then
TempText = UCase(Left(TempText, 1)) & Mid(TempText, 2, Len(TempText))
Shp.TextFrame.TextRange.Text = TempText
Shp.TextFrame.TextRange.Select
With Selection.Font
.Color = wdColorBlack
.Size = 12
.Name = "Arial"
End With
End If
Next
Next i
On Error GoTo 0
Doc.Save
Doc.Close
FName = Dir()
Loop

'Cleanup
AppWrd.Quit
Set AppWrd = Nothing
Set Doc = Nothing
Set Shp = Nothing

End Sub

[The Tamer]

Hi Jake,



I'm using Word 97, and there's an issue with "Color" vs "ColorIndex", and between "wdColorBlack" and "wdBlack" - but that's sorted now. However...

I put a couple of word docs in my C/Temp folder and run your macro - but it made no changes to the docs in that folder - but it did change the text in the open documents - but not in the textboxes.

I don't mind if I have to open each doc individually - that's not a problem - but any idea why it's missing the text boxes?

Thanks for your time on this.

Damo

[Jacob Hilderbrand]

I have some references to ActiveDocument, but that may be causing problems for you. Try this:

Option Explicit

Sub CleanUpDocs()

Dim i As Long
Dim TempText As String
Dim Shp As Shape
Dim Path As String
Dim Doc As Document
Dim FName As String
Dim AppWrd As New Word.Application

'This is the path of the folder to look in.
Path = "C:\Temp"

'Loop through all documents in the specified folder.
FName = Dir(Path & "\*.doc", vbNormal)
Do Until FName = ""
Set Doc = AppWrd.Documents.Open(FileName:=Path & "\" & FName)
Doc.Activate

'Modify the general text
Selection.WholeStory
With Selection.Font
.Color = wdColorBlack
.Size = 12
.Name = "Arial"
End With

'Loop through all shapes to modify TextBox text.
On Error Resume Next
For i = 1 To Doc.Shapes.Count
For Each Shp In Doc.Shapes(i).GroupItems
TempText = Shp.TextFrame.TextRange.Text
If Len(TempText) > 0 Then
TempText = UCase(Left(TempText, 1)) & Mid(TempText, 2, Len(TempText))
Shp.TextFrame.TextRange.Text = TempText
Shp.TextFrame.TextRange.Select
With Selection.Font
.Color = wdColorBlack
.Size = 12
.Name = "Arial"
End With
End If
Next
Next i
On Error GoTo 0
Doc.Save
Doc.Close
FName = Dir()
Loop

'Cleanup
AppWrd.Quit
Set AppWrd = Nothing
Set Doc = Nothing
Set Shp = Nothing

End Sub

Unfortunately I don't have Word 97 to test on. Let me know if this works or not.

[The Tamer]

That worked great thanks

Damo

:)

[Jacob Hilderbrand]

You're Welcome :)

Take Care