79084697

Date: 2024-10-14 04:29:37
Score: 0.5
Natty:
Report link

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.

Reasons:
  • Blacklisted phrase (0.5): Thanks
  • Blacklisted phrase (0.5): thanks
  • Blacklisted phrase (2): crear
  • Whitelisted phrase (-2): I solved
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (0.5):
Posted by: Emanuele Tinari