Replace font size with macro

Itkind · #1 02-26-2017, 11:42 AM

Hi,

I have been searching for this a long time.
Is it possible just to replace with a macro let´s say Times New Roman pt. 12 with Times New Roman pt.8?
I need a macro for this, because I want to handle more than 100 files.

And why it doesn´t work with the macro recorder? When I record the replacement and run the macro all fonts are replaced and not only Times New Roman.

Can someone please help me with this?

gmaxey · #2 02-26-2017, 03:07 PM

You must be doing something wrong.

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Font.Name = "Times New Roman"
    .Font.Size = 12
    .Replacement.Font.Size = 8
    .Execute Replace:=wdReplaceAll
  End With
lbl_Exit:
  Exit Sub
End Sub

Itkind · #3 02-26-2017, 03:46 PM

Hi gmaxey, thank you for your answer. Unfortunaly it doesen´t work. I get no error, but nothing changes.

gmaxey · #4 02-27-2017, 04:34 AM

You will have to attach a document with a sample of your text, because it works fine here as does a recorded version:

Code:

Sub Macro1()
  Selection.Find.ClearFormatting
  Selection.Find.Font.Size = 12
  Selection.Find.Replacement.ClearFormatting
  Selection.Find.Replacement.Font.Size = 8
  With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
  End With
  Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Itkind · #5 02-27-2017, 05:37 AM

This makes all my text smaller, not only Times New Roman. This is what I get when doing the macro recording.

gmaxey · #6 02-27-2017, 05:47 AM

Like I said, send a sample of your text.

Ulodesk · #7 03-06-2017, 08:33 AM

Just curious, Greg, that the recorded version you posted does not appear to specify the font name as your manually-coded one does. Perhaps something in "clear formatting" takes care of that? (You can see how much I know about VBA...)
Trying to think through the potential cause, I can only come up with a conflict between style and local formatting, but don't know why Word wouldn't recognize the "overlay" font anyway. Will be interested to follow the thread.

macropod · #8 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