If ZeroPos > 0 Then FontName = Left$(FontName, ZeroPos - 1) Private Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, ByVal dwType As Long, ByVal lpData As Long) As LongĬall CopyMemory(LF, ByVal lplf, LenB(LF))įontName = StrConv(LF.lfFaceName, vbUnicode) Private Function EnumFontProc(ByVal lplf As LongPtr, ByVal lptm As LongPtr, ByVal dwType As LongPtr, ByVal lpData As LongPtr) As LongPtr 'Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long 'Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Longĭeclare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)ĭeclare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hdc As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Longĭeclare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private sFontsList As String 'String listing all the system fontsĭeclare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)ĭeclare PtrSafe Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hdc As LongPtr, ByVal lpsz As String, ByVal lpFontEnumProc As LongPtr, ByVal lParam As LongPtr) As Longĭeclare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr Simply copy/paste the following code into a Standard Module and call the GetListFonts() function (which will return an array of all the available system fonts). However, when I worked on my MS Access – Improved HTML demo I decided I didn’t want any such dependencies and developed some code to do without Word as an intermediary and I thought I’d share it. Back in 2015 I posted my article VBA – Enumerate Fonts which extracted a list of system fonts by automating Word.
0 Comments
Leave a Reply. |