VBA - Como carregar fontes sem instalar com AddFontResource

Esta dica vai mostrar-lhe como usar uma fonte ausente do PC, sem instalá-la. 

As declarações

Vamos usar o API do Windows, mais particularmente, as funções AddFontResource eRemoveFontResource da biblioteca gdi32.dll. Eles devem ser instalados no PC em questão (ver C:\WINDOWS\system32). 

Funções da biblioteca gdi32.dll

O código destas declarações deve ser colocado no Cabeçalho do módulo, antes de quaisquer declarações de Sub e/ou de Função: 

 Opção Explicita

#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

Observe, aqui, o teste #If #If VBA7 And Win64 que permite operar estas funções nos dois sistemas, 32 e 64 bits. Essas funções usam um único parâmetro: 

lpFileName: trata-se do caminho para o arquivo Fonte. Vamos supor que você coloque suas fontes adicionais no mesmo diretório que o seu arquivo Excel, no subdiretório \Fonts. 

As constantes

Depois de carregar sua fonte, para aplicá-la a um objeto no seu arquivo Excel (ou documento do Word), você deve usar o nome da fonte. Mas, o Nome da Fonte (Font.Name) não é necessariamente idêntico ao nome do arquivo TTF</bold> (ou OTF, etc.). Para encontrar, sem erro, o nome de sua fonte, você precisa procura-la nas propriedades de seus arquivos fonte. Para isso, clique com o botão direito na guia Detalhe. O nome da fonte corresponde ao Título. 

Nós vamos, então, colocar os nomes (títulos) das fontes usadas na pasta Excel, nas constantes. Assim, será mais fácil de reutiliza-las, como quisermos, em qualquer parte do código. No zip anexado, você vai encontrar as três fontes usadas aqui. Sob a declaração das funções do API, declare suas constantes, como, por exemplo: 

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
    'Nome da fonte ALTCAPS.TTF :
    Public Const ALTCAPS As String = "PR Uncial Alternate Capitals" 
    'Nome da fonte Antipasto_regular.otf
    Public Const ANTIPASTO_REGULAR As String = "Antipasto"
    'Nome da Fonte Bobbleboddy.ttf 
    Public Const BOBBLEBODDY As String = "bubbleboddy Fat" 

Você pode observar nos comentários do código acima, que os nomes dos arquivos Fonte não correspondem ao Font.Name a ser usado nos seus códigos. 

As funções

Vamos, agora, criar duas funções para carregar e descarregar as fontes suplementares, assim como a Sub, permitindo a sua aplicação a um objeto.

Como carregar uma fonte

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

O parâmetro usado nesta função, strCaminhoArquivoFonte, é uma String (cadeia de caracteres) que contém o caminho completo para o arquivo fonte. Por exemplo: C:\Meus Documentos\TRABALHO\Arquivos Urgentes\Fonts\Bobbleboddy.ttf. Nossa função vai resultar em um valor de tipo longo. Se este valor for maior do que 0, é porque a fonte foi devidamente carregada. 

Como descarregar uma fonte

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

Mesmas observações que para a função de carregamento. 

Observação: se você não descarregar a sua fonte depois de usá-la, ela permanecerá ativa para todos os seus aplicativos (Word, PowerPoint, Excel, etc.) até o fechamento da sessão do Windows. 

Como aplicar em um objeto

Vamos criar um Sub aqui para fazê-lo. Na verdade, você pode ser levado a realizar esta operação várias vezes, principalmente em um formulário de usuário. Coloque esse código em um Sub exclusivo para não repetir o mesmo código várias vezes e facilitar a manutenção. 

Public Sub AplicarFonte(Obj As Object, fontname As String)
   Obj.Font.Name = fontname
End Sub

Nós temos dois parâmetros: 

Obj As Object: qualquer objeto que possui uma propriedade fonte. Exemplos: um Range, uma Marca, etc. 
fontname As String: o nome da sua fonte. Atenção, não o nome do arquivo, mas sim o seu título (veja acima). 

Como chamar essas funções

Uma exemplo de chamada que utiliza as constantes já declaradas. Em uma planilha: 

Planilha2, célula H10:M25 

Sub Test()
Dim L As Long
    
    L = Charger_Police(ThisWorkbook.Path & "\Fonts\ALTCAPS.TTF")
    If L > 0 Then
        Call Aplicar fonte(Sheets("Feuil2").Range("H10:M25"), ALTCAPS)
    Else
        MsgBox "Fonte não encontrada ou arquivo errado."
    End If
End Sub

Em um formulário de usuário. No carregamento: 

Para a etiqueta1 

Private Sub UserForm_Initialize()
Dim L As Long
    
    L = Carregar_Fonte(ThisWorkbook.Path & "\Fonts\ALTCAPS.TTF")
    If L > 0 Then
        Call Aplicarfonte(Label1, ALTCAPS)
    Else
        MsgBox "Fonte não encontrada ou arquivo errado."
    End If
End Sub

Fonte: http://br.ccm.net/faq/

• Twitter
• Facebook
• Google +
• Linkedin
• Pinterest