VBA Charger une police sans l'installer - AddFontResource

Décembre 2016


Cette astuce décrit comment, sans l'installer, utiliser une police absente du pc.


Les déclarations

Nous allons utiliser l'API Windows, et plus particulièrement les fonctions AddFontResource et RemoveFontResource de la library gdi32.dll. Celle-ci doit être installée sur le(s) pc(s) concerné(s) (cf répertoire C:\WINDOWS\system32).

Fonctions de la gdi32.dll

Le code de ces déclarations doit être placé en entête de module, avant toutes déclarations de Sub et/ou de fonction.
Option Explicit

#If VBA7 And Win64 Then
    Public Declare PtrSafe Function AddFontResource _
        Lib "gdi32" Alias "AddFontResourceA" _
        (ByVal lpFileName As String) As Long
            
    Public Declare PtrSafe Function RemoveFontResource _
        Lib "gdi32" Alias "RemoveFontResourceA" _
        (ByVal lpFileName As String) As Long
#Else
    Public Declare Function AddFontResource _
        Lib "gdi32" Alias "AddFontResourceA" _
        (ByVal lpFileName As String) As Long
            
    Public Declare Function RemoveFontResource _
        Lib "gdi32" Alias "RemoveFontResourceA" _
        (ByVal lpFileName As String) As Long
#End If

A noter ici le test #If VBA7 And Win64 qui permet de faire fonctionner ces fonctions sous les deux systèmes, 32 et 64 bits.

Ces fonctions utilisent un seul et même paramètre : lpFileName. Il s'agit du chemin d'accès à votre fichier "police".

Nous allons supposer que vous placerez vos polices supplémentaires dans le même répertoire que votre fichier Excel, dans un sous-répertoire "\Fonts".

Les constantes

Une fois votre police chargée, pour l'appliquer à un objet de votre classeur excel (ou de votre document Word), il vous faut utiliser le nom de cette police. Or, le nom de la police (Font.Name) n'est pas nécessairement identique au nom du fichier TTF (ou otf, etc.).
Pour trouver, à coups sur, le nom de votre police, il vous faut aller voir dans les propriétés de votre fichier font.
Clic droit sur le fichier, onglet Détail.
Le nom de la police correspond au Titre.

Nous allons donc placer les noms (titres) des polices utilisées dans le classeur, dans des constantes. Ainsi il est plus aisé de les réutiliser à volonté partout dans le code.
Dans le zip ci-joint, vous trouverez les trois polices utilisées ici.
Sous la déclaration des fonctions API, déclarez vos constantes, par exemple :

Option Explicit

#If VBA7 And Win64 Then
    Public Declare PtrSafe Function AddFontResource _
        Lib "gdi32" Alias "AddFontResourceA" _
        (ByVal lpFileName As String) As Long
            
    Public Declare PtrSafe Function RemoveFontResource _
        Lib "gdi32" Alias "RemoveFontResourceA" _
        (ByVal lpFileName As String) As Long
#Else
    Public Declare Function AddFontResource _
        Lib "gdi32" Alias "AddFontResourceA" _
        (ByVal lpFileName As String) As Long
            
    Public Declare Function RemoveFontResource _
        Lib "gdi32" Alias "RemoveFontResourceA" _
        (ByVal lpFileName As String) As Long
#End If
    'Nom de la police ALTCAPS.TTF :
    Public Const ALTCAPS As String = "PR Uncial Alternate Capitals" 
    'Nom de la police Antipasto_regular.otf
    Public Const ANTIPASTO_REGULAR As String = "Antipasto"
    'Nom de la police Bobbleboddy.ttf 
    Public Const BOBBLEBODDY As String = "bubbleboddy Fat" 

Vous voyez dans les commentaires du code ci-dessus que les noms des fichiers "police" ne correspondent pas aux Font.Name à utiliser dans vos codes...

Les fonctions

Nous allons maintenant créer les deux fonctions permettant de charger et décharger la(les) police(s) supplémentaires, ainsi que la Sub permettant son application à un objet.

Charger une police

Public Function Charger_Police(ByVal strCheminFichierPolice As String) As Long
    Charger_Police = AddFontResource(strCheminFichierPolice)
End Function

Le paramètre passé à cette fonction, strCheminFichierPolice, est un String contenant le chemin d'accès complet à votre fichier font.
Par exemple : C:\Mes documents\TRAVAIL\Fichiers Urgents\Fonts\Bobbleboddy.ttf

Notre fonction va retourner une valeur de type Long. Si cette valeur est supérieure à 0, la police est correctement chargée.

Décharger une police

Public Function Decharger_Police_Bis(ByVal strCheminFichierPolice As String) As Long
    Decharger_Police_Bis = RemoveFontResource(strCheminFichierPolice)
End Function

Mêmes commentaires que pour la fonction de chargement.

A noter : si vous ne "déchargez" pas votre police en fin d'utilisation, elle sera active pour toutes vos applications (word, powerpoint, excel, etc.) jusqu'à la fermeture de votre session windows.

Application à un Objet

Nous allons créer ici une Sub pour réaliser cela. En effet, vous pouvez (notamment dans un UserForm) être amené à réaliser cette opération plusieurs fois. Placer ce code dans une Sub à cet effet exclusif, vous permet de ne pas répéter le même code plusieurs fois et de faciliter la maintenance.
Public Sub AppliquerPolice(Obj As Object, fontname As String)
   Obj.Font.Name = fontname
End Sub

Nous avons ici deux paramètres :
Obj As Object : Tout objet possédant une propriété font. Exemples : un Range, un Label, etc...
fontname As String : le nom de votre police. Attention, pas le nom du fichier, mais bel et bien son titre (cf ci-dessus).

Appel de ces fonctions

Un exemple d'appel utilisant les constantes déclarées précédemment :
Dans une feuille : Feuil2, plage H10:M25
Sub Test()
Dim L As Long
    
    L = Charger_Police(ThisWorkbook.Path & "\Fonts\ALTCAPS.TTF")
    If L > 0 Then
        Call AppliquerPolice(Sheets("Feuil2").Range("H10:M25"), ALTCAPS)
    Else
        MsgBox "Police non trouvée ou fichier erroné."
    End If
End Sub

Dans un Userform : au chargement, pour le Label1 :
Private Sub UserForm_Initialize()
Dim L As Long
    
    L = Charger_Police(ThisWorkbook.Path & "\Fonts\ALTCAPS.TTF")
    If L > 0 Then
        Call AppliquerPolice(Label1, ALTCAPS)
    Else
        MsgBox "Police non trouvée ou fichier erroné."
    End If
End Sub

Exemple à télécharger

http://www.cjoint.com/c/FGfi6TNNXHE

Pour que cet exemple fonctionne, il vous faut en dézipper le contenu dans un seul répertoire.
N'hésitez pas à me contacter pour tous commentaires.

A voir également :

Ce document intitulé «  VBA Charger une police sans l'installer - AddFontResource  » issu de CommentCaMarche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.