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].
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