Font Load Once

Question

Hi

I would like to ask that how it could be possible that fonts loaded one time when workbook is open.

The following code worked as macro but it won't work it in ThisWorkbook Module

#If Win64 Then  'If the 64-Bit System

Private Declare PtrSafe Function AddFontResource Lib "gdi32.dll" Alias "AddFontResourceA" ( _

ByVal lpFileName As String) As Long

#Else   'If the 32-Bit System

Private Declare Function AddFontResource Lib "gdi32.dll" Alias "AddFontResourceA" ( _

ByVal lpFileName As String) As Long

#End If

Private Sub Workbook_Open()

Dim Result As Long

Static RO As Boolean    'RO => Run Once

If RO Then

MsgBox "Already Inserted!", vbExclamation

Exit Sub

End If

RO = True

Result = AddFontResource(ThisWorkbook.Path & "\MyFont.ttf")

MsgBox Result & " fonts added"

End Sub

Thanks & Regards

Muneeb

Answer 1

Sorry for the disturbance

It is already be solved by this forum. I did some editing with what I need which is given below

Thanks

#If Win64 Then  'If the 64-Bit System

Private Declare PtrSafe Function AddFontResource Lib "gdi32.dll" Alias "AddFontResourceA" ( _

    ByVal lpFileName As String) As Long

#Else   'If the 32-Bit System

Private Declare Function AddFontResource Lib "gdi32.dll" Alias "AddFontResourceA" ( _

    ByVal lpFileName As String) As Long

#End If

Private Sub Workbook_Open()

    Dim wsActive As Worksheet

    Dim wsTest As Worksheet

    'With a Modal Userform the following code does not run until Userform closes

    Set wsActive = ActiveSheet  'Need to return to active sheet after adding worksheet

    On Error Resume Next

    Set wsTest = Worksheets("Muneeb")

    On Error GoTo 0

    If Not wsTest Is Nothing Then   'Not nothing then is something so sheet exists

        'MsgBox "Code has run once so exit here."    'Delete this line after testing

        Exit Sub

    End If

    Result = AddFontResource(ThisWorkbook.Path & "\DIPLOMA.ttf")

    MsgBox Result & " fonts added"

    Application.ScreenUpdating = False

    Sheets.Add After:=Sheets(Sheets.Count)

    Set wsTest = ActiveSheet

    wsTest.Name = "Muneeb"   'Can use any name but edit test code above to same name

    wsActive.Activate   'Return to active sheet before hiding added sheet

    wsTest.Visible = xlSheetVeryHidden  'Very Hidden cannot be unhidden from Interactive mode

End Sub