我正在尝试编写由Ascii Art形成的文本。
例如"Hi"。
这对我来说很难，所以我在这里寻求你的帮助。
下面是我目前所做的：
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
我不知道怎么连接字符串，因为如果我从第一个字母开始形成单词“HI”，我可以在For...Next循环中找到“H”，我可以提取第一个字母“H”，但我该如何说VBA遍历所有数组并带来所谓的LetterH？
没有办法获得带有Letter& [letter find]的数组名称。
编辑。
感谢@Spencer Barnes，我解决了我的问题。
这就是我所做的，希望将来能为某人服务。
对不起，我只是从我的模块中复制和粘贴，所以所有的变量、常数、注释和其他文本都是意大利语（翻译过于困难和漫长），但是VBA是可以的，我可以构建我的 Ascii-Art 文本。
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
非常感谢大家。
