如何測試使用VBA安裝字體？

Question

檢查使用VBA安裝特定字體的最簡單方法是什麼？

Answer 1

好的，真正的形式我發現這個發現後30秒找到了解決方案。儘管這是訴諸SO前10分鐘的搜索....使用API​​

http://j-walk.com/ss/excel/tips/tip79.htm

Answer 2

有

EnumFonts 的EnumFonts函數枚舉一個指定的設備上可用的字體。對於具有指定字體名稱的每種字體，EnumFonts函數會檢索有關該字體的信息並將其傳遞給應用程序定義的回調函數。這個回調函數可以根據需要處理字體信息。繼續枚舉直到沒有更多字體或回調函數返回零。

VB4-32,5,6

Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hDC As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long 

或

的EnumFontFamilies函數枚舉在指定的字體系列可用一個指定設備上的字體。該函數取代EnumFonts函數。

VB4-32,5,6

Declare Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, ByVal lParam As Long) As Long 

示例例程

'In a module 
Public Const NTM_REGULAR = &H40& 
Public Const NTM_BOLD = &H20& 
Public Const NTM_ITALIC = &H1& 
Public Const TMPF_FIXED_PITCH = &H1 
Public Const TMPF_VECTOR = &H2 
Public Const TMPF_DEVICE = &H8 
Public Const TMPF_TRUETYPE = &H4 
Public Const ELF_VERSION = 0 
Public Const ELF_CULTURE_LATIN = 0 
Public Const RASTER_FONTTYPE = &H1 
Public Const DEVICE_FONTTYPE = &H2 
Public Const TRUETYPE_FONTTYPE = &H4 
Public Const LF_FACESIZE = 32 
Public Const LF_FULLFACESIZE = 64 
Type LOGFONT 
    lfHeight As Long 
    lfWidth As Long 
    lfEscapement As Long 
    lfOrientation As Long 
    lfWeight As Long 
    lfItalic As Byte 
    lfUnderline As Byte 
    lfStrikeOut As Byte 
    lfCharSet As Byte 
    lfOutPrecision As Byte 
    lfClipPrecision As Byte 
    lfQuality As Byte 
    lfPitchAndFamily As Byte 
    lfFaceName(LF_FACESIZE) As Byte 
End Type 
Type NEWTEXTMETRIC 
    tmHeight As Long 
    tmAscent As Long 
    tmDescent As Long 
    tmInternalLeading As Long 
    tmExternalLeading As Long 
    tmAveCharWidth As Long 
    tmMaxCharWidth As Long 
    tmWeight As Long 
    tmOverhang As Long 
    tmDigitizedAspectX As Long 
    tmDigitizedAspectY As Long 
    tmFirstChar As Byte 
    tmLastChar As Byte 
    tmDefaultChar As Byte 
    tmBreakChar As Byte 
    tmItalic As Byte 
    tmUnderlined As Byte 
    tmStruckOut As Byte 
    tmPitchAndFamily As Byte 
    tmCharSet As Byte 
    ntmFlags As Long 
    ntmSizeEM As Long 
    ntmCellHeight As Long 
    ntmAveWidth As Long 
End Type 
Declare Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hDC As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, LParam As Any) As Long 
Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal FontType As Long, LParam As Long) As Long 
    Dim FaceName As String 
    'convert the returned string to Unicode 
    FaceName = StrConv(lpNLF.lfFaceName, vbUnicode) 
    'print the form on Form1 
    Form1.Print Left$(FaceName, InStr(FaceName, vbNullChar) - 1) 
    'continue enumeration 
    EnumFontFamProc = 1 
End Function 

'In a form 
Private Sub Form_Load() 
    'KPD-Team 2000 
    'URL: http://www.allapi.net/ 
    'E-Mail: KPDTeam@Allapi.net 
    Dim hDC As Long 
    'set graphics mode to persistent 
    Me.AutoRedraw = True 
    'enumerates the fonts 
    EnumFontFamilies Me.hDC, vbNullString, AddressOf EnumFontFamProc, ByVal 0& 
End Sub 

Answer 3

http://www.vbcity.com/forums/topic.asp?tid=57012
重定向到
http://vbcity.com/forums/t/55257.aspx

這VB6代碼是兼容VBA：

Function FontIsInstalled(sFont As String) As Boolean 
    '' This reference should already be set by default 
    '' Tools > References > OLE Automation 
    Dim NewFont As StdFont 
    On Error Resume Next 
    Set NewFont = New StdFont 
    With NewFont 
     ' Assign the proposed font name 
     ' Will not be assigned if font doesn't exist 
     .Name = sFont 
     ' Return true if font assignment succeded 
     FontIsInstalled = (StrComp(sFont, .Name, vbTextCompare) = 0) 
     ' return actual font name through arguments 
     sFont = .Name 
    End With 
End Function