Font substitution in Excel

Question

I have an Excel file with cells formatted with Trade Gothic LT Std font, and my computer has Trade Gothic LT Pro installed, which I believe is basically the same. It seems Excel is substituting the font with Courier New instead. Is there a way to force the substitution? I need to convert the file to PDF with the correct font.

I have tried replacing the format, but there are 70 sheets and Excel crashed.

Is there a solution with VBA?

The best and fastest is VBA Macro,,, please [edit] your post and include a bottom line,, that you need a VBA based solution as well add new TAG VBA to the post. — Rajesh Sinha, Nov 13 '20 at 07:27
@RajeshS Thanks. I had something else in mind: a kind of substitution table where I can tell that font X is to be substituted with font Y (some programs can do that). If it's format replacement with VBA, I think I can handle it: I tried on a single sheet and recorded the macro, now I have to loop on all the sheets, and I believe Excel won't crash. — , Nov 13 '20 at 07:48
Ok, found it, but I looked in the wrong place, the substitution is system wide: https://superuser.com/questions/1512694/is-it-possible-to-alias-fonts-in-windows-10 — , Nov 13 '20 at 08:20

score 0 · Answer 1 · answered Nov 13 '20 at 08:51

I would like to suggest VBA macro help you to replace a particular font with new across sheets.

Sub ChangeFont()

Dim vNamesFind
Dim vNamesReplace
Dim sFileName As String
Dim Wkb As Workbook
Dim Wks As Worksheet
Dim rCell As Range
Dim x As Integer
Dim iFonts As Integer
Dim sPath As String


vNamesFind = Array("Arial")

vNamesReplace = Array("Times New Roman")

sPath = "C:\Your Folder Name\"

Application.ScreenUpdating = False
iFonts = UBound(vNamesFind)
If iFonts <> UBound(vNamesReplace) Then
    MsgBox "Find & Replace Fonts must be the same size"
    Exit Sub
End If
sFileName = Dir(sPath & "*.xls")
Do While sFileName <> ""
    Set Wkb = Workbooks.Open(sPath & sFileName)
    For Each Wks In Wkb.Worksheets
        For Each rCell In Wks.UsedRange
            For x = 0 To iFonts
                With rCell.Font
                    If .Name = vNamesFind(x) Then _
                        .Name = vNamesReplace(x)
                End With
            Next
        Next
    Next
    Wkb.Close(True)
    sFileName = Dir
Loop
Application.ScreenUpdating = True
Set rCell = Nothing
Set Wks = Nothing
Set Wkb = Nothing
End Sub

How it works:

For better management create a New folder and save the workbook on which you want to apply new font.
"C:\Your Folder Name\" is editable as well the FONTS Arial & New Times Roman also.
Use this macro as Standard Module in another Workbook (other than on which you want to apply new font).
Save the file as Macro Enabled (*.xlsm)
When you run this Macro, it opens the workbook in the folder, then it go through all sheets, and if the cell has one of the fonts to be found, then it replace it with the new font.

Hope you are working with a machine has enough memory and faster processor.

Font substitution in Excel

1 Answers1