If you don't need a sorted array, just delete the last line of the code above.
QuickSortStringArray FontArray(), 0, UBound(FontArray) The following code will populate - and sort - the FontArray() variable: Dim LF As LOGFONTĮnumFontFamiliesEx hDC, LF, AddressOf EnumFontFamProc, ByVal 0&, 0 QuickSortStringArray avarIn(), intX, intHighBound QuickSortStringArray avarIn(), intLowBound, intY VarMidBound = avarIn((intLowBound + intHighBound) \ 2)ĭo While intX = varMidBound And avarIn(intY) varMidBound Then 'Calculate the value of the middle array element 'avarIn() - array of Strings that gets sortedĭim varMidBound As Variant, varTmp As Variant Public Sub QuickSortStringArray(avarIn() As String, ByVal intLowBound As Integer, _ 'Place the Font name into the newly dimensioned Array element.įontArray(FntInc) = Left$(FaceName, InStr(FaceName, vbNullChar) - 1) 'Dimension the FontArray array variable to hold the next Font Name. Private Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal FontType As Long, LParam As Long) As LongįaceName = StrConv(lpNLF.lfFaceName, vbUnicode) 'Declare variables required for this module.ĭim FontArray() As String 'The Array that will hold all the Fonts (needed for sorting)ĭim FntInc As Integer 'The FontArray element incremental counter. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hDC As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long, ByVal LParam As Long, ByVal dw As Long) As Long
Given the code from the link above (the relevant parts are reproduced here): Option Explicit
#POWERPOINT MISSING FONTS WINDOWS#
This VBA fills an Access combo box, however you may be able to adapt it to your needs, as all you need to do is get an array or other structure containing the fonts installed in Windows and compare it against your ActivePresentation.Fonts(i) There is a solution using Windows API calls here.
0 kommentar(er)
