Replace font size with macro

macropod · #1 03-06-2017, 01:48 PM

For whatever reason, the macro recorder doesn't capture the font name for either the Find or the Replace. Hence a recorded macro will affect content other than just Times New Roman. Regardless, a macro this limited wouldn't make it any easier to "handle more than 100 files" as specified in post #1. For that, you'd need something like:

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      With .Range.Find
        .ClearFormatting
        .Text = ""
        .Font.Name = "Times New Roman"
        .Font.Size = 12
        With .Replacement
          .ClearFormatting
          .Text = ""
          .Font.Size = 8
        End With
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
      End With
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

The above code includes a folder browser and will update all files in the selected folder.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Font size showing different (some superscripted??) but tools show its the same size?	mikkygee	PowerPoint	4	12-14-2015 11:21 PM
Looping Macro to Change Font, Font Size, and Give Heading 1	WH7262	Word VBA	1	08-26-2014 03:46 PM
Character based Search and Replace font size	anacond11	Word	2	08-08-2013 08:10 AM
MAcro to List all the Font & its size in a word document	shaukat74	Word VBA	1	01-29-2013 09:34 PM
how change size font to inches size	kkepo	Word	4	08-28-2012 08:53 PM