VBA 和 Ascii 艺术

Question

我正在尝试编写用 Ascii Art 形成的文本。
例如“嗨”。
这对我来说很难，所以我来这里寻求你的帮助。
到目前为止我正在做的事情是：

\n

\nOption Explicit\n\' I tried with a Type.\nPrivate Type LetterH\n    H1 As String\n    H2 As String\n    H3 As String\n    H4 As String\n    H5 As String\n    H6 As String\n    H7 As String\nEnd Type\n\nSub BuildAsciiWrite(strTxt As String)\n\nDim H As LetterH\n    \' Fill the Type for H letter.\n    H.H1 = "HHH    HHH"\n    H.H2 = "HHH    HHH"\n    H.H3 = "HHH    HHH"\n    H.H4 = "HHHHHHHHHH"\n    H.H5 = "HHH    HHH"\n    H.H6 = "HHH    HHH"\n    H.H7 = "HHH    HHH"\n\n\' Then I tried with Arrays:\n\nDim LtH(1 To 7) As String\n    \' Fill the Array for H letter.\n    LtH(1) = "HHH    HHH"\n    LtH(2) = "HHH    HHH"\n    LtH(3) = "HHH    HHH"\n    LtH(4) = "HHHHHHHHHH"\n    LtH(5) = "HHH    HHH"\n    LtH(6) = "HHH    HHH"\n    LtH(7) = "HHH    HHH"\n\nDim LtI(1 To 7) As String\n    \' Fill the Array for I letter.\n    LtI(1) = "IIIIIIIIIII"\n    LtI(2) = "    III    "\n    LtI(3) = "    III    "\n    LtI(4) = "    III    "\n    LtI(5) = "    III    "\n    LtI(6) = "    III    "\n    LtI(7) = "IIIIIIIIIII"\n\n    \' All strTxt UPPERCASE.\n    strTxt = UCase(strTxt)\n\n\' Array strArrayTxt contains strTxt one letter for one of the text.\nDim strArrayTxt() As String\n    \' Redim Array for the lenght of strTxt.\n    ReDim strArrayTxt(1 To Len(strTxt))\n\' Loop all letters of strTxt.\nDim intLoop1 As Integer\n    For intLoop1 = 1 To Len(strTxt)\n        \' Fill Array with letters of strTxt.\n        strArrayTxt(intLoop1) = Mid$(strTxt, intLoop1, 1)\n    \' Next letter.\n    Next intLoop1\n    \' Empty Var.\n    intLoop1 = 0\n\n\' Var for the complete text we\'ll create.\nDim strWrite As String\n\' Another Array for all 26 letters of the alphabeth.\nDim Letters() As String\nReDim Letters(1 To 26)\n    For intLoop1 = 1 To 26\n        Letters(intLoop1) = Chr$(64 + intLoop1)\n    Next intLoop1\n\n\' At this point I got:\n\' Type LetterH (an Array) with all the 7 strings that I can retrieve with H1, H2 and so on.\n\' Array LtH (1 To 7) with all the 7 strings building the "H" in Ascii.\n\' Array LtI (1 To 7) with all the 7 strings building the "I" in Ascii.\n\' Array strArrayTxt(1 To Len(strTxt)) with all the letters that form my choose word.\n\' Array Letters(1 To 26) with all the 26 letters of the alphabeth.\n\n\' Then I tried:\nDim intLoop2 as Integer    \n    For intLoop2 = 1 To intLunghScritta\n        For intLoop1 = 1 To 26\n            If strArrayTesto(intLoop2) = Letters(intLoop1) Then\n                \' This give me error.\n                \'strWrite = strArrayTesto(intLoop2).strArrayTesto(intLoop2) & intLoop1\n\n                \' I can write in Immediate when find in Array Letters() the same letter find in\n                \' Array strArrayTxt().\n                Debug.Print strArrayTxt(intLoop2) & " = " & Letters(intLoop1)\n            End If\n        Next intLoop1\n    Next intLoop2\n\n\nEnd Sub\n\' Test SUB.\nSub Test_BuildAsciiWrite()\nDim strTxt As String\n    strTxt = "Hi"\n    BuildAsciiWrite (strTxt)\nEnd Sub\n\n

\n

我不知道如何连接字符串，因为如果我从第一个字母组成单词“HI”开始，我可以在 For...Next 循环中找到“H”，我可以提取第一个字母“H”，但是我怎样才能说 VBA 遍历所有数组并带来所谓的 LetterH 吗？
无法通过 Letter & [letter find] 获取数组名称。

\n

编辑。

\n

感谢@Spencer Barnes我解决了我的问题。
这就是我所做的，希望将来能为某人服务。
抱歉，我只是从模块中复制并粘贴，因此所有 Vars、Const、注释和其他文本都是意大利语（翻译起来太难、太长），但 VBA 没问题，我可以构建我的 Ascii-Art 文本。

\n

\nOption Explicit\nOption Private Module\n\n\' La Costante contiene uno Spazio di testo.\nPublic Const Spazio As String = " "\n\n\' La Costante contiene i caratteri iniziali di linea (solo "\'+").\nPublic Const CaratteriIniziali As String = "\'+"\n\n\' La Costante contiene i caratteri finali di linea (solo "+vbCrLf").\nPublic Const CaratteriFinali = "+" & vbCrLf\n\n\n\nSub Prova_CreaScrittaAscii()\nDim strTesto As String\n    strTesto = "Ciao"\n    Call CreaScrittaAscii(strTesto, True)\nEnd Sub\n\n\n\nSub CreaScrittaAscii(strTesto As String, Optional ByVal bolCommentoExcel As Boolean = True)\n\n\' Gestione errore.\nOn Error GoTo GesErr\n\n\' L\'Array viene caricato coi valori delle lettere Ascii-Art.\nDim Lettere(1 To 26, 1 To 7) As String\n\' Stringa passata dalla MsgBox.\nDim strMsg As String\n\' La stringa contiene la prima e l\'ultima riga del testo.\nDim strPU As String\n\' La stringa contiene la riga vuota.\nDim strV As String\n\' La Var conterr\xc3\xa0 il testo completo della scritta che si verr\xc3\xa0 a creare.\nDim strScritta As String\n\' La Var servir\xc3\xa0 per il primo ciclo nell\'Array.\nDim intCiclo1 As Integer\n\' La Var servir\xc3\xa0 per il secondo ciclo nell\'Array.\nDim intCiclo2 As Integer\n\' La Var servir\xc3\xa0 per trovare la posizione della lettera nell\'alfabeto.\nDim lngNumeroLettera As Long\n\' La Var conterr\xc3\xa0 la stringa che si viene a formare riga per riga.\nDim strCostruisciRiga As String\n\' L\'Array conterr\xc3\xa0, divisa per righe, il testo gi\xc3\xa0 formattato in Ascii-Art.\nDim CostruisciRiga(1 To 7) As String\n\n\' Carico l\'Array per la Lettera A.\nLettere(1, 1) = "    AAA    "\nLettere(1, 2) = "  AAA AAA  "\nLettere(1, 3) = " AAA   AAA "\nLettere(1, 4) = "AAAAAAAAAAA"\nLettere(1, 5) = "AAA     AAA"\nLettere(1, 6) = "AAA     AAA"\nLettere(1, 7) = "AAA     AAA"\n\n\' Carico l\'Array per la Lettera B.\nLettere(2, 1) = "BBBBBBBBB "\nLettere(2, 2) = "BBB    BBB"\nLettere(2, 3) = "BBB    BBB"\nLettere(2, 4) = "BBBBBBBBB "\nLettere(2, 5) = "BBB    BBB"\nLettere(2, 6) = "BBB    BBB"\nLettere(2, 7) = "BBBBBBBBB "\n\n\' Carico l\'Array per la Lettera C.\nLettere(3, 1) = " CCCCCCCC "\nLettere(3, 2) = "CCC    CCC"\nLettere(3, 3) = "CCC       "\nLettere(3, 4) = "CCC       "\nLettere(3, 5) = "CCC       "\nLettere(3, 6) = "CCC    CCC"\nLettere(3, 7) = " CCCCCCCC "\n\n\' Carico l\'Array per la Lettera D.\nLettere(4, 1) = "DDDDDDDDD "\nLettere(4, 2) = "DDD    DDD"\nLettere(4, 3) = "DDD    DDD"\nLettere(4, 4) = "DDD    DDD"\nLettere(4, 5) = "DDD    DDD"\nLettere(4, 6) = "DDD    DDD"\nLettere(4, 7) = "DDDDDDDDD "\n\n\' Carico l\'Array per la Lettera E.\nLettere(5, 1) = "EEEEEEEEEE"\nLettere(5, 2) = "EEE"\nLettere(5, 3) = "EEE"\nLettere(5, 4) = "EEEEEEEE"\nLettere(5, 5) = "EEE"\nLettere(5, 6) = "EEE"\nLettere(5, 7) = "EEEEEEEEEE"\n\n\' Carico l\'Array per la Lettera F.\nLettere(6, 1) = "FFFFFFFFFF"\nLettere(6, 2) = "FFF       "\nLettere(6, 3) = "FFF       "\nLettere(6, 4) = "FFFFFFFF  "\nLettere(6, 5) = "FFF       "\nLettere(6, 6) = "FFF       "\nLettere(6, 7) = "FFF       "\n\n\' Carico l\'Array per la Lettera G.\nLettere(7, 1) = " GGGGGGGG "\nLettere(7, 2) = "GGG    GGG"\nLettere(7, 3) = "GGG       "\nLettere(7, 4) = "GGG       "\nLettere(7, 5) = "GGG   GGGG"\nLettere(7, 6) = "GGG    GGG"\nLettere(7, 7) = " GGGGGGGG "\n\n\' Carico l\'Array per la Lettera H.\nLettere(8, 1) = "HHH    HHH"\nLettere(8, 2) = "HHH    HHH"\nLettere(8, 3) = "HHH    HHH"\nLettere(8, 4) = "HHHHHHHHHH"\nLettere(8, 5) = "HHH    HHH"\nLettere(8, 6) = "HHH    HHH"\nLettere(8, 7) = "HHH    HHH"\n\n\' Carico l\'Array per la Lettera I.\nLettere(9, 1) = "IIIIIIIIIII"\nLettere(9, 2) = "    III    "\nLettere(9, 3) = "    III    "\nLettere(9, 4) = "    III    "\nLettere(9, 5) = "    III    "\nLettere(9, 6) = "    III    "\nLettere(9, 7) = "IIIIIIIIIII"\n\n\' Carico l\'Array per la Lettera J.\nLettere(10, 1) = "JJJJJJJJJJJ"\nLettere(10, 2) = "    JJJ    "\nLettere(10, 3) = "    JJJ    "\nLettere(10, 4) = "    JJJ    "\nLettere(10, 5) = "    JJJ    "\nLettere(10, 6) = "JJJ JJJ    "\nLettere(10, 7) = " JJJJJ     "\n\n\' Carico l\'Array per la Lettera K.\nLettere(11, 1) = "KKK    KKK"\nLettere(11, 2) = "KKK   KKK "\nLettere(11, 3) = "KKK  KKK  "\nLettere(11, 4) = "KKKKKKK   "\nLettere(11, 5) = "KKK  KKK  "\nLettere(11, 6) = "KKK   KKK "\nLettere(11, 7) = "KKK    KKK"\n\n\' Carico l\'Array per la Lettera L.\nLettere(12, 1) = "LLL       "\nLettere(12, 2) = "LLL       "\nLettere(12, 3) = "LLL       "\nLettere(12, 4) = "LLL       "\nLettere(12, 5) = "LLL       "\nLettere(12, 6) = "LLL       "\nLettere(12, 7) = "LLLLLLLLLL"\n\n\' Carico l\'Array per la Lettera M.\nLettere(13, 1) = "MMMM    MMMM "\nLettere(13, 2) = "MMMMMM MMMMMM"\nLettere(13, 3) = "MMM MMMMM MMM"\nLettere(13, 4) = "MMM  MMM  MMM"\nLettere(13, 5) = "MMM       MMM"\nLettere(13, 6) = "MMM       MMM"\nLettere(13, 7) = "MMM       MMM"\n\n\' Carico l\'Array per la Lettera N.\nLettere(14, 1) = "NNNN    NNN"\nLettere(14, 2) = "NNNNN   NNN"\nLettere(14, 3) = "NNNNNN  NNN"\nLettere(14, 4) = "NNN NNN NNN"\nLettere(14, 5) = "NNN  NNNNNN"\nLettere(14, 6) = "NNN   NNNNN"\nLettere(14, 7) = "NNN    NNNN"\n\n\' Carico l\'Array per la Lettera O.\nLettere(15, 1) = " OOOOOOOO "\nLettere(15, 2) = "OOO    OOO"\nLettere(15, 3) = "OOO    OOO"\nLettere(15, 4) = "OOO    OOO"\nLettere(15, 5) = "OOO    OOO"\nLettere(15, 6) = "OOO    OOO"\nLettere(15, 7) = " OOOOOOOO "\n\n\' Carico l\'Array per la Lettera P.\nLettere(16, 1) = "PPPPPPPPP "\nLettere(16, 2) = "PPP    PPP"\nLettere(16, 3) = "PPP    PPP"\nLettere(16, 4) = "PPPPPPPPP "\nLettere(16, 5) = "PPP       "\nLettere(16, 6) = "PPP       "\nLettere(16, 7) = "PPP       "\n\n\' Carico l\'Array per la Lettera Q.\nLettere(17, 1) = " QQQQQQQQ  "\nLettere(17, 2) = "QQQ    QQQ "\nLettere(17, 3) = "QQQ    QQQ "\nLettere(17, 4) = "QQQ    QQQ "\nLettere(17, 5) = "QQQ  Q QQQ "\nLettere(17, 6) = "QQQ   QQQ  "\nLettere(17, 7) = " QQQQQQ QQQ"\n\n\' Carico l\'Array per la Lettera R.\nLettere(18, 1) = "RRRRRRRRR "\nLettere(18, 2) = "RRR    RRR"\nLettere(18, 3) = "RRR    RRR"\nLettere(18, 4) = "RRRRRRRRR "\nLettere(18, 5) = "RRR    RRR"\nLettere(18, 6) = "RRR    RRR"\nLettere(18, 7) = "RRR    RRR"\n\n\' Carico l\'Array per la Lettera S.\nLettere(19, 1) = " SSSSSSSS "\nLettere(19, 2) = "SSS    SSS"\nLettere(19, 3) = "SSS       "\nLettere(19, 4) = "SSSSSSSSSS"\nLettere(19, 5) = "       SSS"\nLettere(19, 6) = "SSS    SSS"\nLettere(19, 7) = " SSSSSSSS "\n\n\' Carico l\'Array per la Lettera T.\nLettere(20, 1) = "TTTTTTTTTTT"\nLettere(20, 2) = "    TTT    "\nLettere(20, 3) = "    TTT    "\nLettere(20, 4) = "    TTT    "\nLettere(20, 5) = "    TTT    "\nLettere(20, 6) = "    TTT    "\nLettere(20, 7) = "    TTT    "\n\n\' Carico l\'Array per la Lettera U.\nLettere(21, 1) = "UUU    UUU"\nLettere(21, 2) = "UUU    UUU"\nLettere(21, 3) = "UUU    UUU"\nLettere(21, 4) = "UUU    UUU"\nLettere(21, 5) = "UUU    UUU"\nLettere(21, 6) = "UUU    UUU"\nLettere(21, 7) = " UUUUUUUU "\n\n\' Carico l\'Array per la Lettera V.\nLettere(22, 1) = "VVV     VVV"\nLettere(22, 2) = "VVV     VVV"\nLettere(22, 3) = "VVV     VVV"\nLettere(22, 4) = "VVV     VVV"\nLettere(22, 5) = " VVV   VVV "\nLettere(22, 6) = "  VVVVVVV  "\nLettere(22, 7) = "    VVV    "\n\n\' Carico l\'Array per la Lettera W.\nLettere(23, 1) = "WWW       WWW"\nLettere(23, 2) = "WWW       WWW"\nLettere(23, 3) = "WWW       WWW"\nLettere(23, 4) = "WWW  WWW  WWW"\nLettere(23, 5) = "WWW WWWWW WWW"\nLettere(23, 6) = " WWWWW WWWWW "\nLettere(23, 7) = "  WWW   WWW  "\n\n\' Carico l\'Array per la Lettera X.\nLettere(24, 1) = "XXX    XXX"\nLettere(24, 2) = "XXX    XXX"\nLettere(24, 3) = " XXX  XXX "\nLettere(24, 4) = "  XXXXXX  "\nLettere(24, 5) = " XXX  XXX "\nLettere(24, 6) = "XXX    XXX"\nLettere(24, 7) = "XXX    XXX"\n\n\' Carico l\'Array per la Lettera Y.\nLettere(25, 1) = "YYY   YYY"\nLettere(25, 2) = "YYY   YYY"\nLettere(25, 3) = " YYY YYY "\nLettere(25, 4) = "  YYYYY  "\nLettere(25, 5) = "   YYY   "\nLettere(25, 6) = "   YYY   "\nLettere(25, 7) = "   YYY   "\n\n\' Carico l\'Array per la Lettera Z.\nLettere(26, 1) = "ZZZZZZZZZ"\nLettere(26, 2) = "     ZZZ "\nLettere(26, 3) = "    ZZZ  "\nLettere(26, 4) = "   ZZZ   "\nLettere(26, 5) = "  ZZZ    "\nLettere(26, 6) = " ZZZ     "\nLettere(26, 7) = "ZZZZZZZZZ"\n    \n    \' Se la Var strTesto contiene caratteri minuscoli, li converte tutti in maiuscoli.\n    strTesto = UCase(strTesto)\n    \n    \' Se bolCommentoExcel \xc3\xa8 True, allora.\n    If bolCommentoExcel = True Then\n        \' Prima e ultima riga.\n        strPU = "\'" & StringaRipeti(98, "+") & CaratteriFinali\n        \' Riga vuota.\n        strV = "\'+" & StringaRipeti(97, Spazio) & CaratteriFinali\n        \' Prima riga (solo "+").\n        strScritta = strScritta & strPU\n        \' Riga vuota.\n        strScritta = strScritta & strV\n    End If\n    \n    \' Se bolCommentoExcel \xc3\xa8 True, allora.\n    If bolCommentoExcel = True Then\n\n        \' Ciclo per ognuna delle 7 righe del carattere Ascii-Art.\n        For intCiclo1 = 1 To 7\n            \' Ciclo per ogni lettera della strTesto.\n            For intCiclo2 = 1 To Len(strTesto)\n                \' Getting the 1-26 number\n                lngNumeroLettera = InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase(Mid(strTesto, intCiclo2, 1)))\n                strCostruisciRiga = strCostruisciRiga & Lettere(lngNumeroLettera, intCiclo1) & Spazio\n            \' Prossima lettera nella strTesto.\n            Next intCiclo2\n            \' L\'Array viene riempito con la riga costruita in strCostruisciRiga.\n            CostruisciRiga(intCiclo1) = strCostruisciRiga\n            \' La Var viene svuotata.\n            strCostruisciRiga = Empty\n        Next intCiclo1\n        \n        \' Se la lunghezza della scritta che si verr\xc3\xa0 a creare \xc3\xa8 maggiore di 95, allora.\n        If Len(CostruisciRiga(1)) > 95 Then\n            \' Avvisa.\n            strMsg = MsgBox("Il numero di spazi necessari a contenere la scritta:" & _\n                    Chr(13) & Chr(10) & strTesto & _\n                    Chr(13) & Chr(10) & "(" & Len(CostruisciRiga(1)) & " caratteri necessari)" & _\n                    Chr(13) & Chr(10) & "\xc3\xa8 superiore ai 95 caratteri disponibili." & _\n                    Chr(13) & Chr(10) & "Correggere. Esco.", _\n                    vbCritical + vbOKOnly, "A T T E N Z I O N E !")\n            \' Esce dalla Sub.\n            GoTo Uscita\n        End If\n    \n        \' Ciclo per ognuna delle 7 righe dell\'Array CostruisciRiga.\n        For intCiclo1 = 1 To 7\n            \' Concateno i caratteri iniziali della riga.\n            strScritta = strScritta & CaratteriIniziali\n            \' Inserisce tanti spazi vuoti quanti sono la differenza tra 97 e la lunghezza della stringa\n            \' nell\'Array, diviso 2 (prende solo la parte fissa prima della eventuale virgola.\n            strScritta = strScritta & StringaRipeti(Fix((97 - Len(CostruisciRiga(1))) / 2), Spazio)\n            \' Aggiunge la riga in elaborazione nell\'Array.\n            strScritta = strScritta & CostruisciRiga(intCiclo1)\n            \' Inserisce tanti spazi vuoti finali quanti sono la differenza tra 97,\n            \' i caratteri vuoti iniziali e la lunghezza della stringa nell\'Array.\n            strScritta = strScritta & StringaRipeti((97 - (Fix((97 - Len(CostruisciRiga(1))) / 2)) - (Len(CostruisciRiga(1)))), Spazio)\n            \' Concateno il carattere di fine linea.\n            strScritta = strScritta & CaratteriFinali\n        \' Riga successiva nell\'Array.\n        Next intCiclo1\n    \n        \' Penultima riga (vuota).\n        strScritta = strScritta & strV\n    \n        \' Ultima riga (solo "+").\n        strScritta = strScritta & strPU\n    \n    ElseIf bolCommentoExcel = False Then\n\n        \' Ciclo per ognuna delle 7 righe del carattere Ascii-Art.\n        For intCiclo1 = 1 To 7\n            \' Ciclo per ogni lettera della strTesto.\n            For intCiclo2 = 1 To Len(strTesto)\n                \' Getting the 1-26 number\n                lngNumeroLettera = InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase(Mid(strTesto, intCiclo2, 1)))\n                strCostruisciRiga = strCostruisciRiga & Lettere(lngNumeroLettera, intCiclo1) & Spazio\n            \' Prossima lettera nella strTesto.\n            Next intCiclo2\n            \' L\'Array viene riempito con la riga costruita in strCostruisciRiga.\n            CostruisciRiga(intCiclo1) = strCostruisciRiga\n            \' La Var viene svuotata.\n            strCostruisciRiga = Empty\n        Next intCiclo1\n        \n        \' Ciclo per ognuna delle 7 righe dell\'Array CostruisciRiga.\n        For intCiclo1 = 1 To 7\n            \' Aggiunge la riga in elaborazione nell\'Array.\n            strScritta = strScritta & CostruisciRiga(intCiclo1)\n            \' Concateno il carattere di fine linea.\n            strScritta = strScritta & vbCrLf\n        \' Riga successiva nell\'Array.\n        Next intCiclo1\n    \n    End If\n    \n    \' Chiama la Function ScriviFileTemp.\n    ScriviFileTemp (strScritta)\n\n\' Esce dalla Sub, dopo aver svuotato la/e variabile/i.\nUscita: strTesto = Empty\n        Erase Lettere\n        strMsg = Empty\n        strPU = Empty\n        strV = Empty\n        strScritta = Empty\n        intCiclo1 = Empty\n        intCiclo2 = Empty\n        lngNumeroLettera = Empty\n        strCostruisciRiga = Empty\n        Erase CostruisciRiga\n        Exit Sub\n\' Questa riga di uscita viene raggiunta in caso di errore.\nGesErr: MsgBox "Errore nella Sub" & vbCrLf & _\n        "\'CreaScrittaAscii\'" & vbCrLf & vbCrLf & _\n        "Errore Numero: " & Err.Number & vbCrLf & _\n        "Descrizione dell\'errore:" & vbCrLf & _\n        Err.Description, vbCritical, "C\'\xc3\xa8 stato un errore!"\n        Resume Uscita\n\' Fine della Sub.\nEnd Sub\n\n\n\n\n\nPublic Function ScriviFileTemp(ByVal strTesto As String, _\n                               Optional ByVal strPercorso As String, _\n                               Optional ByVal strNomeFile As String, _\n                               Optional strEstensione As String = "txt") _\n                               As String\n\n\' Gestione errore.\nOn Error GoTo GesErr\n\n\' La Var conterr\xc3\xa0 il percorso e il nome del file.\nDim strPercorsoNomeFile As String\n\' La Var conterr\xc3\xa0 il numero del file che stiamo andando a creare.\nDim intNumFile As Integer\n    \n    \' Se la Var passata alla Funzione, contenente il nome del file, \xc3\xa8 vuota, allora.\n    If strNomeFile = "" Then\n        \' Crea il nome del file. L\'estensione se non \xc3\xa8 passata dalla Var, viene usata quella di default.\n        strNomeFile = Format(Date, "ddmmmyyyy") & "_" & Format(Time, "hhmmss") & "." & strEstensione\n    End If\n    \' Se la Var passata alla Funzione, contenente il percorso del file, \xc3\xa8 vuota, allora.\n    If strPercorso = "" Then\n        \' Crea il percorso alla cartella temporanea.\n        strPercorso = Environ("TMP") & Application.PathSeparator\n    End If\n    \' Poi concatena le due stringe per ottenere il file.\n    strPercorsoNomeFile = strPercorso & strNomeFile\n    \n    \' Il numero del file temporareo \xc3\xa8 il prossimo numero disponibile.\n    intNumFile = FreeFile()\n    Open strPercorsoNomeFile For Output As intNumFile\n    Print #intNumFile, strTesto;\n    Close #intNumFile\n    \' Apre il file creato con Notepad massimizzato.\n    Shell "Notepad.exe " & strPercorsoNomeFile, vbMaximizedFocus\n    \' La Funzione restituisce il percorso e il nome del file creato.\n    ScriviFileTemp = strPercorsoNomeFile\n\n\' Esce dalla Funzione, dopo aver svuotato la/e variabile/i.\nUscita: strTesto = Empty\n        strPercorso = Empty\n        strNomeFile = Empty\n        strEstensione = Empty\n        strPercorsoNomeFile = Empty\n        intNumFile = Empty\n        Exit Function\n\' Questa riga di uscita viene raggiunta in caso di errore.\nGesErr: MsgBox "Errore nella Function" & vbCrLf & "\'ScriviFileTemp\'" & vbCrLf & vbCrLf & "Errore Numero: " & Err.Number & vbCrLf & "Descrizione dell\'errore:" & vbCrLf & Err.Description, vbCritical, "C\'\xc3\xa8 stato un errore!"\n

    

Answer 1

您可以使用二维数组来完成此操作。一维是字母，一维是线条（字母由多条线条组成，如上所示）例如：

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