excelvbaascii-art

VBA & Ascii Art


I'm trying to write a text formed with Ascii Art.
For example "Hi".
It's hard for me, so I'm here asking your help.
Here is what I'm do till now:


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 ?
There's no way to obtain Array name with Letter & [letter find].

Edit.

Thanks to @Spencer Barnes I solved my problem.
Here is what I do, hoping 'll serve to someone in the future.
Sorry I just copy and paste from my Module, so all Vars, Const, Comments and other text are in Italian language (too hard and long to translate), but VBA is ok and I can build my Ascii-Art text.


Option Explicit
Option Private Module

' La Costante contiene uno Spazio di testo.
Public Const Spazio As String = " "

' La Costante contiene i caratteri iniziali di linea (solo "'+").
Public Const CaratteriIniziali As String = "'+"

' La Costante contiene i caratteri finali di linea (solo "+vbCrLf").
Public Const CaratteriFinali = "+" & vbCrLf



Sub Prova_CreaScrittaAscii()
Dim strTesto As String
    strTesto = "Ciao"
    Call CreaScrittaAscii(strTesto, True)
End Sub



Sub CreaScrittaAscii(strTesto As String, Optional ByVal bolCommentoExcel As Boolean = True)

' Gestione errore.
On Error GoTo GesErr

' L'Array viene caricato coi valori delle lettere Ascii-Art.
Dim Lettere(1 To 26, 1 To 7) As String
' Stringa passata dalla MsgBox.
Dim strMsg As String
' La stringa contiene la prima e l'ultima riga del testo.
Dim strPU As String
' La stringa contiene la riga vuota.
Dim strV As String
' La Var conterrà il testo completo della scritta che si verrà a creare.
Dim strScritta As String
' La Var servirà per il primo ciclo nell'Array.
Dim intCiclo1 As Integer
' La Var servirà per il secondo ciclo nell'Array.
Dim intCiclo2 As Integer
' La Var servirà per trovare la posizione della lettera nell'alfabeto.
Dim lngNumeroLettera As Long
' La Var conterrà la stringa che si viene a formare riga per riga.
Dim strCostruisciRiga As String
' L'Array conterrà, divisa per righe, il testo già formattato in Ascii-Art.
Dim CostruisciRiga(1 To 7) As String

' Carico l'Array per la Lettera A.
Lettere(1, 1) = "    AAA    "
Lettere(1, 2) = "  AAA AAA  "
Lettere(1, 3) = " AAA   AAA "
Lettere(1, 4) = "AAAAAAAAAAA"
Lettere(1, 5) = "AAA     AAA"
Lettere(1, 6) = "AAA     AAA"
Lettere(1, 7) = "AAA     AAA"

' Carico l'Array per la Lettera B.
Lettere(2, 1) = "BBBBBBBBB "
Lettere(2, 2) = "BBB    BBB"
Lettere(2, 3) = "BBB    BBB"
Lettere(2, 4) = "BBBBBBBBB "
Lettere(2, 5) = "BBB    BBB"
Lettere(2, 6) = "BBB    BBB"
Lettere(2, 7) = "BBBBBBBBB "

' Carico l'Array per la Lettera C.
Lettere(3, 1) = " CCCCCCCC "
Lettere(3, 2) = "CCC    CCC"
Lettere(3, 3) = "CCC       "
Lettere(3, 4) = "CCC       "
Lettere(3, 5) = "CCC       "
Lettere(3, 6) = "CCC    CCC"
Lettere(3, 7) = " CCCCCCCC "

' Carico l'Array per la Lettera D.
Lettere(4, 1) = "DDDDDDDDD "
Lettere(4, 2) = "DDD    DDD"
Lettere(4, 3) = "DDD    DDD"
Lettere(4, 4) = "DDD    DDD"
Lettere(4, 5) = "DDD    DDD"
Lettere(4, 6) = "DDD    DDD"
Lettere(4, 7) = "DDDDDDDDD "

' Carico l'Array per la Lettera E.
Lettere(5, 1) = "EEEEEEEEEE"
Lettere(5, 2) = "EEE"
Lettere(5, 3) = "EEE"
Lettere(5, 4) = "EEEEEEEE"
Lettere(5, 5) = "EEE"
Lettere(5, 6) = "EEE"
Lettere(5, 7) = "EEEEEEEEEE"

' Carico l'Array per la Lettera F.
Lettere(6, 1) = "FFFFFFFFFF"
Lettere(6, 2) = "FFF       "
Lettere(6, 3) = "FFF       "
Lettere(6, 4) = "FFFFFFFF  "
Lettere(6, 5) = "FFF       "
Lettere(6, 6) = "FFF       "
Lettere(6, 7) = "FFF       "

' Carico l'Array per la Lettera G.
Lettere(7, 1) = " GGGGGGGG "
Lettere(7, 2) = "GGG    GGG"
Lettere(7, 3) = "GGG       "
Lettere(7, 4) = "GGG       "
Lettere(7, 5) = "GGG   GGGG"
Lettere(7, 6) = "GGG    GGG"
Lettere(7, 7) = " GGGGGGGG "

' Carico l'Array per la Lettera H.
Lettere(8, 1) = "HHH    HHH"
Lettere(8, 2) = "HHH    HHH"
Lettere(8, 3) = "HHH    HHH"
Lettere(8, 4) = "HHHHHHHHHH"
Lettere(8, 5) = "HHH    HHH"
Lettere(8, 6) = "HHH    HHH"
Lettere(8, 7) = "HHH    HHH"

' Carico l'Array per la Lettera I.
Lettere(9, 1) = "IIIIIIIIIII"
Lettere(9, 2) = "    III    "
Lettere(9, 3) = "    III    "
Lettere(9, 4) = "    III    "
Lettere(9, 5) = "    III    "
Lettere(9, 6) = "    III    "
Lettere(9, 7) = "IIIIIIIIIII"

' Carico l'Array per la Lettera J.
Lettere(10, 1) = "JJJJJJJJJJJ"
Lettere(10, 2) = "    JJJ    "
Lettere(10, 3) = "    JJJ    "
Lettere(10, 4) = "    JJJ    "
Lettere(10, 5) = "    JJJ    "
Lettere(10, 6) = "JJJ JJJ    "
Lettere(10, 7) = " JJJJJ     "

' Carico l'Array per la Lettera K.
Lettere(11, 1) = "KKK    KKK"
Lettere(11, 2) = "KKK   KKK "
Lettere(11, 3) = "KKK  KKK  "
Lettere(11, 4) = "KKKKKKK   "
Lettere(11, 5) = "KKK  KKK  "
Lettere(11, 6) = "KKK   KKK "
Lettere(11, 7) = "KKK    KKK"

' Carico l'Array per la Lettera L.
Lettere(12, 1) = "LLL       "
Lettere(12, 2) = "LLL       "
Lettere(12, 3) = "LLL       "
Lettere(12, 4) = "LLL       "
Lettere(12, 5) = "LLL       "
Lettere(12, 6) = "LLL       "
Lettere(12, 7) = "LLLLLLLLLL"

' Carico l'Array per la Lettera M.
Lettere(13, 1) = "MMMM    MMMM "
Lettere(13, 2) = "MMMMMM MMMMMM"
Lettere(13, 3) = "MMM MMMMM MMM"
Lettere(13, 4) = "MMM  MMM  MMM"
Lettere(13, 5) = "MMM       MMM"
Lettere(13, 6) = "MMM       MMM"
Lettere(13, 7) = "MMM       MMM"

' Carico l'Array per la Lettera N.
Lettere(14, 1) = "NNNN    NNN"
Lettere(14, 2) = "NNNNN   NNN"
Lettere(14, 3) = "NNNNNN  NNN"
Lettere(14, 4) = "NNN NNN NNN"
Lettere(14, 5) = "NNN  NNNNNN"
Lettere(14, 6) = "NNN   NNNNN"
Lettere(14, 7) = "NNN    NNNN"

' Carico l'Array per la Lettera O.
Lettere(15, 1) = " OOOOOOOO "
Lettere(15, 2) = "OOO    OOO"
Lettere(15, 3) = "OOO    OOO"
Lettere(15, 4) = "OOO    OOO"
Lettere(15, 5) = "OOO    OOO"
Lettere(15, 6) = "OOO    OOO"
Lettere(15, 7) = " OOOOOOOO "

' Carico l'Array per la Lettera P.
Lettere(16, 1) = "PPPPPPPPP "
Lettere(16, 2) = "PPP    PPP"
Lettere(16, 3) = "PPP    PPP"
Lettere(16, 4) = "PPPPPPPPP "
Lettere(16, 5) = "PPP       "
Lettere(16, 6) = "PPP       "
Lettere(16, 7) = "PPP       "

' Carico l'Array per la Lettera Q.
Lettere(17, 1) = " QQQQQQQQ  "
Lettere(17, 2) = "QQQ    QQQ "
Lettere(17, 3) = "QQQ    QQQ "
Lettere(17, 4) = "QQQ    QQQ "
Lettere(17, 5) = "QQQ  Q QQQ "
Lettere(17, 6) = "QQQ   QQQ  "
Lettere(17, 7) = " QQQQQQ QQQ"

' Carico l'Array per la Lettera R.
Lettere(18, 1) = "RRRRRRRRR "
Lettere(18, 2) = "RRR    RRR"
Lettere(18, 3) = "RRR    RRR"
Lettere(18, 4) = "RRRRRRRRR "
Lettere(18, 5) = "RRR    RRR"
Lettere(18, 6) = "RRR    RRR"
Lettere(18, 7) = "RRR    RRR"

' Carico l'Array per la Lettera S.
Lettere(19, 1) = " SSSSSSSS "
Lettere(19, 2) = "SSS    SSS"
Lettere(19, 3) = "SSS       "
Lettere(19, 4) = "SSSSSSSSSS"
Lettere(19, 5) = "       SSS"
Lettere(19, 6) = "SSS    SSS"
Lettere(19, 7) = " SSSSSSSS "

' Carico l'Array per la Lettera T.
Lettere(20, 1) = "TTTTTTTTTTT"
Lettere(20, 2) = "    TTT    "
Lettere(20, 3) = "    TTT    "
Lettere(20, 4) = "    TTT    "
Lettere(20, 5) = "    TTT    "
Lettere(20, 6) = "    TTT    "
Lettere(20, 7) = "    TTT    "

' Carico l'Array per la Lettera U.
Lettere(21, 1) = "UUU    UUU"
Lettere(21, 2) = "UUU    UUU"
Lettere(21, 3) = "UUU    UUU"
Lettere(21, 4) = "UUU    UUU"
Lettere(21, 5) = "UUU    UUU"
Lettere(21, 6) = "UUU    UUU"
Lettere(21, 7) = " UUUUUUUU "

' Carico l'Array per la Lettera V.
Lettere(22, 1) = "VVV     VVV"
Lettere(22, 2) = "VVV     VVV"
Lettere(22, 3) = "VVV     VVV"
Lettere(22, 4) = "VVV     VVV"
Lettere(22, 5) = " VVV   VVV "
Lettere(22, 6) = "  VVVVVVV  "
Lettere(22, 7) = "    VVV    "

' Carico l'Array per la Lettera W.
Lettere(23, 1) = "WWW       WWW"
Lettere(23, 2) = "WWW       WWW"
Lettere(23, 3) = "WWW       WWW"
Lettere(23, 4) = "WWW  WWW  WWW"
Lettere(23, 5) = "WWW WWWWW WWW"
Lettere(23, 6) = " WWWWW WWWWW "
Lettere(23, 7) = "  WWW   WWW  "

' Carico l'Array per la Lettera X.
Lettere(24, 1) = "XXX    XXX"
Lettere(24, 2) = "XXX    XXX"
Lettere(24, 3) = " XXX  XXX "
Lettere(24, 4) = "  XXXXXX  "
Lettere(24, 5) = " XXX  XXX "
Lettere(24, 6) = "XXX    XXX"
Lettere(24, 7) = "XXX    XXX"

' Carico l'Array per la Lettera Y.
Lettere(25, 1) = "YYY   YYY"
Lettere(25, 2) = "YYY   YYY"
Lettere(25, 3) = " YYY YYY "
Lettere(25, 4) = "  YYYYY  "
Lettere(25, 5) = "   YYY   "
Lettere(25, 6) = "   YYY   "
Lettere(25, 7) = "   YYY   "

' Carico l'Array per la Lettera Z.
Lettere(26, 1) = "ZZZZZZZZZ"
Lettere(26, 2) = "     ZZZ "
Lettere(26, 3) = "    ZZZ  "
Lettere(26, 4) = "   ZZZ   "
Lettere(26, 5) = "  ZZZ    "
Lettere(26, 6) = " ZZZ     "
Lettere(26, 7) = "ZZZZZZZZZ"
    
    ' Se la Var strTesto contiene caratteri minuscoli, li converte tutti in maiuscoli.
    strTesto = UCase(strTesto)
    
    ' Se bolCommentoExcel è True, allora.
    If bolCommentoExcel = True Then
        ' Prima e ultima riga.
        strPU = "'" & StringaRipeti(98, "+") & CaratteriFinali
        ' Riga vuota.
        strV = "'+" & StringaRipeti(97, Spazio) & CaratteriFinali
        ' Prima riga (solo "+").
        strScritta = strScritta & strPU
        ' Riga vuota.
        strScritta = strScritta & strV
    End If
    
    ' Se bolCommentoExcel è True, allora.
    If bolCommentoExcel = True Then

        ' Ciclo per ognuna delle 7 righe del carattere Ascii-Art.
        For intCiclo1 = 1 To 7
            ' Ciclo per ogni lettera della strTesto.
            For intCiclo2 = 1 To Len(strTesto)
                ' Getting the 1-26 number
                lngNumeroLettera = InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase(Mid(strTesto, intCiclo2, 1)))
                strCostruisciRiga = strCostruisciRiga & Lettere(lngNumeroLettera, intCiclo1) & Spazio
            ' Prossima lettera nella strTesto.
            Next intCiclo2
            ' L'Array viene riempito con la riga costruita in strCostruisciRiga.
            CostruisciRiga(intCiclo1) = strCostruisciRiga
            ' La Var viene svuotata.
            strCostruisciRiga = Empty
        Next intCiclo1
        
        ' Se la lunghezza della scritta che si verrà a creare è maggiore di 95, allora.
        If Len(CostruisciRiga(1)) > 95 Then
            ' Avvisa.
            strMsg = MsgBox("Il numero di spazi necessari a contenere la scritta:" & _
                    Chr(13) & Chr(10) & strTesto & _
                    Chr(13) & Chr(10) & "(" & Len(CostruisciRiga(1)) & " caratteri necessari)" & _
                    Chr(13) & Chr(10) & "è superiore ai 95 caratteri disponibili." & _
                    Chr(13) & Chr(10) & "Correggere. Esco.", _
                    vbCritical + vbOKOnly, "A T T E N Z I O N E !")
            ' Esce dalla Sub.
            GoTo Uscita
        End If
    
        ' Ciclo per ognuna delle 7 righe dell'Array CostruisciRiga.
        For intCiclo1 = 1 To 7
            ' Concateno i caratteri iniziali della riga.
            strScritta = strScritta & CaratteriIniziali
            ' Inserisce tanti spazi vuoti quanti sono la differenza tra 97 e la lunghezza della stringa
            ' nell'Array, diviso 2 (prende solo la parte fissa prima della eventuale virgola.
            strScritta = strScritta & StringaRipeti(Fix((97 - Len(CostruisciRiga(1))) / 2), Spazio)
            ' Aggiunge la riga in elaborazione nell'Array.
            strScritta = strScritta & CostruisciRiga(intCiclo1)
            ' Inserisce tanti spazi vuoti finali quanti sono la differenza tra 97,
            ' i caratteri vuoti iniziali e la lunghezza della stringa nell'Array.
            strScritta = strScritta & StringaRipeti((97 - (Fix((97 - Len(CostruisciRiga(1))) / 2)) - (Len(CostruisciRiga(1)))), Spazio)
            ' Concateno il carattere di fine linea.
            strScritta = strScritta & CaratteriFinali
        ' Riga successiva nell'Array.
        Next intCiclo1
    
        ' Penultima riga (vuota).
        strScritta = strScritta & strV
    
        ' Ultima riga (solo "+").
        strScritta = strScritta & strPU
    
    ElseIf bolCommentoExcel = False Then

        ' Ciclo per ognuna delle 7 righe del carattere Ascii-Art.
        For intCiclo1 = 1 To 7
            ' Ciclo per ogni lettera della strTesto.
            For intCiclo2 = 1 To Len(strTesto)
                ' Getting the 1-26 number
                lngNumeroLettera = InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase(Mid(strTesto, intCiclo2, 1)))
                strCostruisciRiga = strCostruisciRiga & Lettere(lngNumeroLettera, intCiclo1) & Spazio
            ' Prossima lettera nella strTesto.
            Next intCiclo2
            ' L'Array viene riempito con la riga costruita in strCostruisciRiga.
            CostruisciRiga(intCiclo1) = strCostruisciRiga
            ' La Var viene svuotata.
            strCostruisciRiga = Empty
        Next intCiclo1
        
        ' Ciclo per ognuna delle 7 righe dell'Array CostruisciRiga.
        For intCiclo1 = 1 To 7
            ' Aggiunge la riga in elaborazione nell'Array.
            strScritta = strScritta & CostruisciRiga(intCiclo1)
            ' Concateno il carattere di fine linea.
            strScritta = strScritta & vbCrLf
        ' Riga successiva nell'Array.
        Next intCiclo1
    
    End If
    
    ' Chiama la Function ScriviFileTemp.
    ScriviFileTemp (strScritta)

' Esce dalla Sub, dopo aver svuotato la/e variabile/i.
Uscita: strTesto = Empty
        Erase Lettere
        strMsg = Empty
        strPU = Empty
        strV = Empty
        strScritta = Empty
        intCiclo1 = Empty
        intCiclo2 = Empty
        lngNumeroLettera = Empty
        strCostruisciRiga = Empty
        Erase CostruisciRiga
        Exit Sub
' Questa riga di uscita viene raggiunta in caso di errore.
GesErr: MsgBox "Errore nella Sub" & vbCrLf & _
        "'CreaScrittaAscii'" & vbCrLf & vbCrLf & _
        "Errore Numero: " & Err.Number & vbCrLf & _
        "Descrizione dell'errore:" & vbCrLf & _
        Err.Description, vbCritical, "C'è stato un errore!"
        Resume Uscita
' Fine della Sub.
End Sub





Public Function ScriviFileTemp(ByVal strTesto As String, _
                               Optional ByVal strPercorso As String, _
                               Optional ByVal strNomeFile As String, _
                               Optional strEstensione As String = "txt") _
                               As String

' Gestione errore.
On Error GoTo GesErr

' La Var conterrà il percorso e il nome del file.
Dim strPercorsoNomeFile As String
' La Var conterrà il numero del file che stiamo andando a creare.
Dim intNumFile As Integer
    
    ' Se la Var passata alla Funzione, contenente il nome del file, è vuota, allora.
    If strNomeFile = "" Then
        ' Crea il nome del file. L'estensione se non è passata dalla Var, viene usata quella di default.
        strNomeFile = Format(Date, "ddmmmyyyy") & "_" & Format(Time, "hhmmss") & "." & strEstensione
    End If
    ' Se la Var passata alla Funzione, contenente il percorso del file, è vuota, allora.
    If strPercorso = "" Then
        ' Crea il percorso alla cartella temporanea.
        strPercorso = Environ("TMP") & Application.PathSeparator
    End If
    ' Poi concatena le due stringe per ottenere il file.
    strPercorsoNomeFile = strPercorso & strNomeFile
    
    ' Il numero del file temporareo è il prossimo numero disponibile.
    intNumFile = FreeFile()
    Open strPercorsoNomeFile For Output As intNumFile
    Print #intNumFile, strTesto;
    Close #intNumFile
    ' Apre il file creato con Notepad massimizzato.
    Shell "Notepad.exe " & strPercorsoNomeFile, vbMaximizedFocus
    ' La Funzione restituisce il percorso e il nome del file creato.
    ScriviFileTemp = strPercorsoNomeFile

' Esce dalla Funzione, dopo aver svuotato la/e variabile/i.
Uscita: strTesto = Empty
        strPercorso = Empty
        strNomeFile = Empty
        strEstensione = Empty
        strPercorsoNomeFile = Empty
        intNumFile = Empty
        Exit Function
' Questa riga di uscita viene raggiunta in caso di errore.
GesErr: MsgBox "Errore nella Function" & vbCrLf & "'ScriviFileTemp'" & vbCrLf & vbCrLf & "Errore Numero: " & Err.Number & vbCrLf & "Descrizione dell'errore:" & vbCrLf & Err.Description, vbCritical, "C'è stato un errore!"
        Resume Uscita
' Fine della Funzione.
End Function

Many thanks at all.


Solution

  • You can do this with a 2-dimensional array. One dimension is the letter, and one is the line (where a letter is made up of multiple lines like the above) For example:

    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