Embedding Fonts in Excel

There's actually a very simple method to embed the font in an Excel file.

1. Create a new sheet called 'fonts'
2. In the fonts sheet Insert > Object > Create from file
Now select your ttf font file, then press OK.

This should now create an object with the name of the font you inserted and a .ttf extension.

3. Select the object, and rename it to the same name as the font, including the .ttf. For example: Linearicons-Free.ttf

4. Add the following VBA code to the 'ThisWorkbook' object in the Visual Basic editor ( Developer > Visual Basic)

' force explicit variable declaration
Option Explicit

' set default array subscripts to 1
Option Base 1

' 32bit & 64bit dec's
#If VBA7 And Win64 Then
Private Declare PtrSafe Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFilename As String) As LongPtr
Private Declare PtrSafe Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFilename As String) As LongPtr
#Else
Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFilename As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFilename As String) As Long
#End If

' // copy the OLE objects out to the users "temp" Folder & install the Fonts as a resource upon opening the Workbook
Private Sub Workbook_Open()

' // vars
Dim objFont As OLEObject
Dim objFilename As String
Dim objShell As Object
Set objShell = CreateObject("shell.application")
Dim objFolder As Variant
Set objFolder = objShell.Namespace(Environ("Temp") & Application.PathSeparator)
Dim objFolderItem As Variant
Set objFolderItem = objFolder.Self

' // copy out the OLE objects from the "fonts" Worksheet into a temp Folder
For Each objFont In Worksheets("fonts").OLEObjects
' // get the Filename of each Font Object
' Please note: you must set this yourself when you add embed the Fonts
objFilename = objFont.Name
' // Copy the Font to the Clipboard
objFont.Copy
' // Paste the Font from the Clipboard to the "temp" Folder
If Dir(CStr(Environ("Temp") & Application.PathSeparator & objFilename), vbDirectory) = vbNullString Then
objFolderItem.InvokeVerb ("Paste")
End If
' // add each Font as a resource in Excel
AddFontResource Environ("Temp") & Application.PathSeparator & objFilename
Next objFont

' fixes Excel 2013 update fonts issue
Application.ScreenUpdating = False: ActiveSheet.Select: Application.ScreenUpdating = True

' // clean up
Set objFont = Nothing
Set objShell = Nothing

End Sub

' // remove the Font resource upon closing the Workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)

' // vars
Dim objFont As OLEObject
Dim objFilename As String

' // loop the OLE objects in the "fonts" Worksheet
For Each objFont In Worksheets("fonts").OLEObjects
' // set the Filename
objFilename = objFont.Name
' // remove the resource
RemoveFontResource Environ("Temp") & Application.PathSeparator & objFilename
Next objFont

' // clean up
Set objFont = Nothing

End Sub


And that's it! Now run the Private Sub Workbook_Open() and you should have the font embedded.