VBA Ascii Art

Question

I'm attempting to write some words using Ascii art.
"Hello," for instance.
I need your assistance because I find it difficult.
Here are my current activities:

Option Explicit
' I tried with a Type.
Private Type LetterH
    H1 As String
    H2 As String
    H3 As String
    H4 As String
    H5 As String
    H6 As String
    H7 As String
End Type

Sub BuildAsciiWrite(strTxt As String)

Dim H As LetterH
    ' Fill the Type for H letter.
    H.H1 = "HHH    HHH"
    H.H2 = "HHH    HHH"
    H.H3 = "HHH    HHH"
    H.H4 = "HHHHHHHHHH"
    H.H5 = "HHH    HHH"
    H.H6 = "HHH    HHH"
    H.H7 = "HHH    HHH"

' Then I tried with Arrays:

Dim LtH(1 To 7) As String
    ' Fill the Array for H letter.
    LtH(1) = "HHH    HHH"
    LtH(2) = "HHH    HHH"
    LtH(3) = "HHH    HHH"
    LtH(4) = "HHHHHHHHHH"
    LtH(5) = "HHH    HHH"
    LtH(6) = "HHH    HHH"
    LtH(7) = "HHH    HHH"

Dim LtI(1 To 7) As String
    ' Fill the Array for I letter.
    LtI(1) = "IIIIIIIIIII"
    LtI(2) = "    III    "
    LtI(3) = "    III    "
    LtI(4) = "    III    "
    LtI(5) = "    III    "
    LtI(6) = "    III    "
    LtI(7) = "IIIIIIIIIII"

    ' All strTxt UPPERCASE.
    strTxt = UCase(strTxt)

' Array strArrayTxt contains strTxt one letter for one of the text.
Dim strArrayTxt() As String
    ' Redim Array for the lenght of strTxt.
    ReDim strArrayTxt(1 To Len(strTxt))
' Loop all letters of strTxt.
Dim intLoop1 As Integer
    For intLoop1 = 1 To Len(strTxt)
        ' Fill Array with letters of strTxt.
        strArrayTxt(intLoop1) = Mid$(strTxt, intLoop1, 1)
    ' Next letter.
    Next intLoop1
    ' Empty Var.
    intLoop1 = 0

' Var for the complete text we'll create.
Dim strWrite As String
' Another Array for all 26 letters of the alphabeth.
Dim Letters() As String
ReDim Letters(1 To 26)
    For intLoop1 = 1 To 26
        Letters(intLoop1) = Chr$(64 + intLoop1)
    Next intLoop1

' At this point I got:
' Type LetterH (an Array) with all the 7 strings that I can retrieve with H1, H2 and so on.
' Array LtH (1 To 7) with all the 7 strings building the "H" in Ascii.
' Array LtI (1 To 7) with all the 7 strings building the "I" in Ascii.
' Array strArrayTxt(1 To Len(strTxt)) with all the letters that form my choose word.
' Array Letters(1 To 26) with all the 26 letters of the alphabeth.

' Then I tried:
Dim intLoop2 as Integer    
    For intLoop2 = 1 To intLunghScritta
        For intLoop1 = 1 To 26
            If strArrayTesto(intLoop2) = Letters(intLoop1) Then
                ' This give me error.
                'strWrite = strArrayTesto(intLoop2).strArrayTesto(intLoop2) & intLoop1

                ' I can write in Immediate when find in Array Letters() the same letter find in
                ' Array strArrayTxt().
                Debug.Print strArrayTxt(intLoop2) & " = " & Letters(intLoop1)
            End If
        Next intLoop1
    Next intLoop2


End Sub
' Test SUB.
Sub Test_BuildAsciiWrite()
Dim strTxt As String
    strTxt = "Hi"
    BuildAsciiWrite (strTxt)
End Sub

I don't know how concatenate strings because if I start with first letter forming word "HI", I can find "H" in a For...Next loop, I can extract first letter, "H" but how can I say VBA go througt all Arrays and bring the so called LetterH ?

Answer 1

This is possible with a two-dimensional array. The letter is one dimension, and the line is another (where a letter is made up of multiple lines like the above) For instance:

Sub BuildAsciiWrite(strInput As String)
Dim Ascii(1 To 26, 1 To 7) As String

'Filling this array will take a lot of code, only showing H and I for demo purposes
'Ascii(8, x) is H, because H is the 8th letter
Ascii(8, 1) = "HHH    HHH  "
Ascii(8, 2) = "HHH    HHH  "
Ascii(8, 3) = "HHH    HHH  "
Ascii(8, 4) = "HHHHHHHHHH  "
Ascii(8, 5) = "HHH    HHH  "
Ascii(8, 6) = "HHH    HHH  "
Ascii(8, 7) = "HHH    HHH  "

'Ascii i, 9th letter
Ascii(9, 1) = "IIIIIIIIIII  "
Ascii(9, 2) = "    III      "
Ascii(9, 3) = "    III      "
Ascii(9, 4) = "    III      "
Ascii(9, 5) = "    III      "
Ascii(9, 6) = "    III      "
Ascii(9, 7) = "IIIIIIIIIII  "

'etc
'notice I added some space to keep letters a bit separate visually

'Now you need some loops to put together your output string
Dim strOutput As String, charNum As Long
For y = 1 To 7 'height
    For x = 1 To Len(strInput)
        'Getting the 1-26 number
        charNum = InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase(Mid(strInput, x, 1)))
        'Alternatively you could use the Asc() function
            'and make your input array line up with ascii character codes
            'and so have both uppercase and lowercase, plus punctuation and things
            'depends how much effort you want to put into this ;)
        strOutput = strOutput & Ascii(charNum, y)
    Next
    strOutput = strOutput & Chr(13) 'new line
Next 'Height

Debug.Print strOutput
End Sub

Sub Test()
Dim MyInput As String
'MyInput = Inputbox("Input HI")
MyInput = "HI"

BuildAsciiWrite MyInput

End Sub