Excel VBA

css navigation by Css3Menu.com

Web Page of Characters

I was sitting around playing with an app I wrote a few days ago that builds a list of fonts. Was wondering if I could make a whole web page of characters based on a font. See example at Arial font.
Sub MakeFontWeb(FontFc As String, MaxChar As LongPtr, FtSize As Integer)

    Dim TRw     As String
    Dim TD      As String
    Dim Qu      As String
    Dim TRc     As String
    Dim eTD     As String
    Dim eTR     As String
    Dim pPath   As String
    Dim Z       As Integer
    Dim J       As Integer
    Dim F       As Integer

 
    TD = " <td>"
    eTD = "</td>"
    eTR = "</tr>"
    Close #1
    Qu = Chr(34)
    pPath = "C:\Users\" & Environ("UserName") & "\"
    TRw = "<tr class=" & Qu & "whtrow" & Qu & ">"
    TRc = "<tr class=" & Qu & "controw" & Qu & ">"
    Open pPath & Trim(FontFc) & ".htm" For Output As #1
    Print #1, "<html>"
    Print #1, "<head>"
    Print #1, "<style type=" & Qu & "text/css" & Qu & ">"
            Print #1, "   .controw"
            Print #1, "   {"
            Print #1, "    background-color: #ddffff;"       'a bunch of HTML related stuff
            Print #1, "    border-bottom-style: ridge;"
            Print #1, "    border-bottom-width: thick;"
            Print #1, "    vertical-align: top;"
            Print #1, "    text-align: center;"
            Print #1, "    font-family:'" & FontFc & "';"
            Print #1, "    }"
            Print #1, "    .whtrow"
            Print #1, "    {"
            Print #1, "    border-bottom-style: ridge;"
            Print #1, "    border-bottom-width: thick;"
            Print #1, "    text-align: center;"
            Print #1, "    vertical-align: top;"
            Print #1, "    font-family:'" & FontFc & "';"
            Print #1, "    }"
    Print #1, "</style>"
    Print #1, "<title>" & "Font: " & FontFc & "</title>"
    Print #1, "</head>" & vbCrLf & "<body>"
    Print #1, "<h1>" & "Font Sample: " & FontFc & "</h1>"
    Print #1, "<table width=" & Qu & "100%" & Qu & " border=" & Qu & "1" & Qu & ">"
     Z = 33
     If MaxChar >= 30000 Then
        MaxChar = InputBox("Your upper limit is producing errors with HTML, try to limit to under 10K", "Problems", 9999)
    End If
     For J = 1 To MaxChar
        Select Case J Mod 2
            Case 1
                Print #1, TRc
                    For F = 1 To 25
                        Select Case Z
                            Case Is <= 255
                                Print #1, TD & Chr(Z) & eTD
                            Case Is > 255
                                Print #1, TD & "&#" & Z & ";" & eTD
                        End Select
                        Z = Z + 1
                    Next F
                Print #1, eTR
            Case 0
                Print #1, TRw
                    For F = 1 To 25
                        Select Case Z
                            Case Is <= 255
                                Print #1, TD & Chr(Z) & eTD
                            Case Is > 255
                                Print #1, TD & "&#" & Z & ";" & eTD
                        End Select
                        Z = Z + 1
                    Next F
                Print #1, eTR
        End Select
       If Z >= MaxChar Then GoTo Fin
       
    Next J
Fin:
    Print #1, "</table>"
    Print #1, "Created: " & Application.Text(Now(), "dd MMM YYYY, HH:mm:ss")
    Print #1, "</body>"
    Print #1, "</html>"
    Close #1
    MsgBox "HMTL is at " & pPath & "MyDocuments\" & vbCrLf & FontFc
End Sub

It is a listtle useless but a nice exercise in what can be done.

© MMXVII

Updated:  12/10/2017 15:42
This page added:  30 September 2017