Ascii Art

'Copy and paste to VBA direct  ready to use
Sub Text_Ascii()
Application.ScreenUpdating = False
   Dim mytext As String
   Dim myalpha As String
   Dim mytype As String
   Dim Count As Integer
   Dim Myrange As Range
   Dim Nbr As Byte
   Dim msg As String
   mytext = Application.InputBox(Prompt:="Your Text Here", Title:="Text to Ascii Art", Default:="Ascii", Type:=2)
   If Not mytext = "False" Then
        If mytext = "" Then Exit Sub
    Else
        Exit Sub
        If mtype = vbNullString Then Exit Sub
    End If
   Do
        mytype = Application.InputBox(Prompt:="Use (All) for standered. or use any symbole @ % # Maximum 5 Char", Title:="Text to Ascii Art", Default:="All", Type:=2)
        Nbr = Len(mytype)
   Loop Until Nbr <= 5 And Nbr > 0
    If Not mytype = "False" Then
        If mytype = "" Then Exit Sub
    Else
        Exit Sub
        If mytype = vbNullString Then Exit Sub
    End If
    Cells.ClearContents
    Range("A1").Select
    Count = Len(mytext)
    Sheets("Sheet2").Select
    For i = 1 To Count
        myalpha = UCase(Mid(mytext, i, 1))
        Ascii_all (myalpha), (i)
    Next i
Set Myrange = Range(ActiveCell.Offset(0, 1).Address & ":" & ActiveCell.Offset(4, i - 1).Address)
If mytype <> "All" Then
    For Each cell In Myrange
        cell.Select
        mytext = cell.Text
        Count = Len(mytext)
        msg = ""
        For i = 1 To Count
            myalpha = UCase(Mid(mytext, i, 1))
            If Nbr > 1 Then
                If Asc(myalpha) <> 160 Then
                    msg = msg & mytype
                Else
                For n = 1 To Nbr
                    msg = msg + myalpha '+ myalpha
                Next
                End If
            Else
                If Asc(myalpha) <> 160 Then
                    msg = msg & mytype
                Else
                    msg = msg + myalpha
                End If
            End If
        Next i
            If Err.Number <> 0 Then
                cell.Value = msg
            Else
                cell.Value = "'" & msg
            End If
    Next cell
End If
    Myrange.Font.Name = "Courier New"
    Myrange.Font.Size = 10
    Myrange.Font.Bold = True
    Myrange.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub
Function Ascii_all(myalpha As String, i As Integer)
    If myalpha = "" Then
            ActiveCell.Offset(0, i).Value = ""
            ActiveCell.Offset(1, i).Value = ""
            ActiveCell.Offset(2, i).Value = ""
            ActiveCell.Offset(3, i).Value = ""
            ActiveCell.Offset(4, i).Value = ""
        ElseIf myalpha = "A" Then
            ActiveCell.Offset(0, i).Value = "  AAA"
            ActiveCell.Offset(1, i).Value = " AAAAA"
            ActiveCell.Offset(2, i).Value = "AA   AA"
            ActiveCell.Offset(3, i).Value = "AAAAAAA"
            ActiveCell.Offset(4, i).Value = "AA   AA"
        ElseIf myalpha = "B" Then
            ActiveCell.Offset(0, i).Value = "BBBBB"
            ActiveCell.Offset(1, i).Value = "BB   B"
            ActiveCell.Offset(2, i).Value = "BBBBBB"
            ActiveCell.Offset(3, i).Value = "BB   BB"
            ActiveCell.Offset(4, i).Value = "BBBBBB"
        ElseIf myalpha = "C" Then
            ActiveCell.Offset(0, i).Value = " CCCCC"
            ActiveCell.Offset(1, i).Value = "CC    C"
            ActiveCell.Offset(2, i).Value = "CC"
            ActiveCell.Offset(3, i).Value = "CC    C"
            ActiveCell.Offset(4, i).Value = " CCCCC"
        ElseIf myalpha = "D" Then
            ActiveCell.Offset(0, i).Value = "DDDDD"
            ActiveCell.Offset(1, i).Value = "DD  DD"
            ActiveCell.Offset(2, i).Value = "DD   DD"
            ActiveCell.Offset(3, i).Value = "DD   DD"
            ActiveCell.Offset(4, i).Value = "DDDDDD"
        ElseIf myalpha = "E" Then
            ActiveCell.Offset(0, i).Value = "EEEEEEE"
            ActiveCell.Offset(1, i).Value = "EE"
            ActiveCell.Offset(2, i).Value = "EEEEE"
            ActiveCell.Offset(3, i).Value = "EE"
            ActiveCell.Offset(4, i).Value = "EEEEEEE"
        ElseIf myalpha = "F" Then
            ActiveCell.Offset(0, i).Value = "FFFFFFF"
            ActiveCell.Offset(1, i).Value = "FF"
            ActiveCell.Offset(2, i).Value = "FFFF"
            ActiveCell.Offset(3, i).Value = "FF"
            ActiveCell.Offset(4, i).Value = "FF"
        ElseIf myalpha = "G" Then
            ActiveCell.Offset(0, i).Value = "  GGGG"
            ActiveCell.Offset(1, i).Value = " GG  GG"
            ActiveCell.Offset(2, i).Value = "GG"
            ActiveCell.Offset(3, i).Value = "GG   GG"
            ActiveCell.Offset(4, i).Value = " GGGGGG"
        ElseIf myalpha = "H" Then
            ActiveCell.Offset(0, i).Value = "HH   HH"
            ActiveCell.Offset(1, i).Value = "HH   HH"
            ActiveCell.Offset(2, i).Value = "HHHHHHH"
            ActiveCell.Offset(3, i).Value = "HH   HH"
            ActiveCell.Offset(4, i).Value = "HH   HH"
        ElseIf myalpha = "I" Then
            ActiveCell.Offset(0, i).Value = "IIIII"
            ActiveCell.Offset(1, i).Value = " III"
            ActiveCell.Offset(2, i).Value = " III"
            ActiveCell.Offset(3, i).Value = " III"
            ActiveCell.Offset(4, i).Value = "IIIII"
        ElseIf myalpha = "J" Then
            ActiveCell.Offset(0, i).Value = "    JJJ"
            ActiveCell.Offset(1, i).Value = "    JJJ"
            ActiveCell.Offset(2, i).Value = "    JJJ"
            ActiveCell.Offset(3, i).Value = "JJ  JJJ"
            ActiveCell.Offset(4, i).Value = " JJJJJ"
        ElseIf myalpha = "K" Then
            ActiveCell.Offset(0, i).Value = "KK  KK"
            ActiveCell.Offset(1, i).Value = "KK KK"
            ActiveCell.Offset(2, i).Value = "KKKK"
            ActiveCell.Offset(3, i).Value = "KK KK"
            ActiveCell.Offset(4, i).Value = "KK  KK"
        ElseIf myalpha = "L" Then
            ActiveCell.Offset(0, i).Value = "LL"
            ActiveCell.Offset(1, i).Value = "LL"
            ActiveCell.Offset(2, i).Value = "LL"
            ActiveCell.Offset(3, i).Value = "LL"
            ActiveCell.Offset(4, i).Value = "LLLLLLL"
        ElseIf myalpha = "M" Then
            ActiveCell.Offset(0, i).Value = "MM    MM"
            ActiveCell.Offset(1, i).Value = "MMM  MMM"
            ActiveCell.Offset(2, i).Value = "MM MM MM"
            ActiveCell.Offset(3, i).Value = "MM    MM"
            ActiveCell.Offset(4, i).Value = "MM    MM"
        ElseIf myalpha = "N" Then
            ActiveCell.Offset(0, i).Value = "NN   NN"
            ActiveCell.Offset(1, i).Value = "NNN  NN"
            ActiveCell.Offset(2, i).Value = "NN N NN"
            ActiveCell.Offset(3, i).Value = "NN  NNN"
            ActiveCell.Offset(4, i).Value = "NN   NN"
        ElseIf myalpha = "O" Then
            ActiveCell.Offset(0, i).Value = " OOOOO"
            ActiveCell.Offset(1, i).Value = "OO   OO"
            ActiveCell.Offset(2, i).Value = "OO   OO"
            ActiveCell.Offset(3, i).Value = "OO   OO"
            ActiveCell.Offset(4, i).Value = " OOOO0"
        ElseIf myalpha = "P" Then
            ActiveCell.Offset(0, i).Value = "PPPPPP"
            ActiveCell.Offset(1, i).Value = "PP   PP"
            ActiveCell.Offset(2, i).Value = "PPPPPP"
            ActiveCell.Offset(3, i).Value = "PP"
            ActiveCell.Offset(4, i).Value = "PP"
        ElseIf myalpha = "Q" Then
            ActiveCell.Offset(0, i).Value = " QQQQQ"
            ActiveCell.Offset(1, i).Value = "QQ   QQ"
            ActiveCell.Offset(2, i).Value = "QQ   QQ"
            ActiveCell.Offset(3, i).Value = "QQ  QQ"
            ActiveCell.Offset(4, i).Value = " QQQQ Q"
        ElseIf myalpha = "R" Then
            ActiveCell.Offset(0, i).Value = "RRRRRR"
            ActiveCell.Offset(1, i).Value = "RR   RR"
            ActiveCell.Offset(2, i).Value = "RRRRRR"
            ActiveCell.Offset(3, i).Value = "RR  RR"
            ActiveCell.Offset(4, i).Value = "RR   RR"
        ElseIf myalpha = "S" Then
            ActiveCell.Offset(0, i).Value = " SSSSS"
            ActiveCell.Offset(1, i).Value = "SS"
            ActiveCell.Offset(2, i).Value = " SSSSS"
            ActiveCell.Offset(3, i).Value = "     SS"
            ActiveCell.Offset(4, i).Value = " SSSSS"
        ElseIf myalpha = "T" Then
            ActiveCell.Offset(0, i).Value = "TTTTTTT"
            ActiveCell.Offset(1, i).Value = "  TTT"
            ActiveCell.Offset(2, i).Value = "  TTT"
            ActiveCell.Offset(3, i).Value = "  TTT"
            ActiveCell.Offset(4, i).Value = "  TTT"
        ElseIf myalpha = "U" Then
            ActiveCell.Offset(0, i).Value = "UU   UU"
            ActiveCell.Offset(1, i).Value = "UU   UU"
            ActiveCell.Offset(2, i).Value = "UU   UU"
            ActiveCell.Offset(3, i).Value = "UU   UU"
            ActiveCell.Offset(4, i).Value = " UUUUU "
        ElseIf myalpha = "V" Then
            ActiveCell.Offset(0, i).Value = "VV     VV"
            ActiveCell.Offset(1, i).Value = "VV     VV"
            ActiveCell.Offset(2, i).Value = " VV   VV"
            ActiveCell.Offset(3, i).Value = "  VV VV"
            ActiveCell.Offset(4, i).Value = "   VVV"
        ElseIf myalpha = "W" Then
            ActiveCell.Offset(0, i).Value = "WW      WW"
            ActiveCell.Offset(1, i).Value = "WW      WW"
            ActiveCell.Offset(2, i).Value = "WW   W  WW"
            ActiveCell.Offset(3, i).Value = " WW WWW WW"
            ActiveCell.Offset(4, i).Value = "  WW   WW"
        ElseIf myalpha = "X" Then
            ActiveCell.Offset(0, i).Value = "XX    XX"
            ActiveCell.Offset(1, i).Value = " XX  XX"
            ActiveCell.Offset(2, i).Value = "  XXXX"
            ActiveCell.Offset(3, i).Value = " XX  XX"
            ActiveCell.Offset(4, i).Value = "XX    XX"
        ElseIf myalpha = "Y" Then
            ActiveCell.Offset(0, i).Value = "YY   YY"
            ActiveCell.Offset(1, i).Value = "YY   YY"
            ActiveCell.Offset(2, i).Value = " YYYYY"
            ActiveCell.Offset(3, i).Value = "  YYY"
            ActiveCell.Offset(4, i).Value = "  YYY"
        ElseIf myalpha = "Z" Then
            ActiveCell.Offset(0, i).Value = "ZZZZZ"
            ActiveCell.Offset(1, i).Value = "   ZZ"
            ActiveCell.Offset(2, i).Value = "  ZZ"
            ActiveCell.Offset(3, i).Value = " ZZ"
            ActiveCell.Offset(4, i).Value = "ZZZZZ"
        ElseIf myalpha = "0" Then
            ActiveCell.Offset(0, i).Value = " 00000"
            ActiveCell.Offset(1, i).Value = "00   00"
            ActiveCell.Offset(2, i).Value = "00   00"
            ActiveCell.Offset(3, i).Value = "00   00"
            ActiveCell.Offset(4, i).Value = " 00000"
        ElseIf myalpha = "1" Then
            ActiveCell.Offset(0, i).Value = " 1"
            ActiveCell.Offset(1, i).Value = "111"
            ActiveCell.Offset(2, i).Value = " 11"
            ActiveCell.Offset(3, i).Value = " 11"
            ActiveCell.Offset(4, i).Value = "1111"
        ElseIf myalpha = "2" Then
            ActiveCell.Offset(0, i).Value = " 2222"
            ActiveCell.Offset(1, i).Value = "222222"
            ActiveCell.Offset(2, i).Value = "    222"
            ActiveCell.Offset(3, i).Value = " 2222"
            ActiveCell.Offset(4, i).Value = "2222222"
        ElseIf myalpha = "3" Then
            ActiveCell.Offset(0, i).Value = "333333"
            ActiveCell.Offset(1, i).Value = "   3333"
            ActiveCell.Offset(2, i).Value = "  3333"
            ActiveCell.Offset(3, i).Value = "    333"
            ActiveCell.Offset(4, i).Value = "333333"
        ElseIf myalpha = "4" Then
            ActiveCell.Offset(0, i).Value = "    44"
            ActiveCell.Offset(1, i).Value = "   444"
            ActiveCell.Offset(2, i).Value = " 44  4"
            ActiveCell.Offset(3, i).Value = "44444444"
            ActiveCell.Offset(4, i).Value = "   444"
        ElseIf myalpha = "5" Then
            ActiveCell.Offset(0, i).Value = "555555"
            ActiveCell.Offset(1, i).Value = "55"
            ActiveCell.Offset(2, i).Value = "555555"
            ActiveCell.Offset(3, i).Value = "   5555"
            ActiveCell.Offset(4, i).Value = "555555"
        ElseIf myalpha = "6" Then
            ActiveCell.Offset(0, i).Value = "  666"
            ActiveCell.Offset(1, i).Value = " 66"
            ActiveCell.Offset(2, i).Value = "666666"
            ActiveCell.Offset(3, i).Value = "66   66"
            ActiveCell.Offset(4, i).Value = " 66666"
        ElseIf myalpha = "7" Then
            ActiveCell.Offset(0, i).Value = "7777777"
            ActiveCell.Offset(1, i).Value = "    777"
            ActiveCell.Offset(2, i).Value = "   777"
            ActiveCell.Offset(3, i).Value = "  777"
            ActiveCell.Offset(4, i).Value = " 777"
        ElseIf myalpha = "8" Then
            ActiveCell.Offset(0, i).Value = " 88888"
            ActiveCell.Offset(1, i).Value = "88   88"
            ActiveCell.Offset(2, i).Value = " 88888"
            ActiveCell.Offset(3, i).Value = "88   88"
            ActiveCell.Offset(4, i).Value = " 88888"
        ElseIf myalpha = "9" Then
            ActiveCell.Offset(0, i).Value = " 99999"
            ActiveCell.Offset(1, i).Value = "99   9"
            ActiveCell.Offset(2, i).Value = " 99999"
            ActiveCell.Offset(3, i).Value = "    99"
            ActiveCell.Offset(4, i).Value = "  999"
        ElseIf myalpha = "-" Then
            ActiveCell.Offset(0, i).Value = " "
            ActiveCell.Offset(1, i).Value = " "
            ActiveCell.Offset(2, i).Value = " ____ "
            ActiveCell.Offset(3, i).Value = " "
            ActiveCell.Offset(4, i).Value = " "
        ElseIf myalpha = "*" Then
            ActiveCell.Offset(0, i).Value = " "
            ActiveCell.Offset(1, i).Value = "*   *"
            ActiveCell.Offset(2, i).Value = " ***"
            ActiveCell.Offset(3, i).Value = " ***"
            ActiveCell.Offset(4, i).Value = "*   *"
        ElseIf myalpha = "/" Then
            ActiveCell.Offset(0, i).Value = "    //"
            ActiveCell.Offset(1, i).Value = "   ///"
            ActiveCell.Offset(2, i).Value = "  ///"
            ActiveCell.Offset(3, i).Value = " ///"
            ActiveCell.Offset(4, i).Value = "///"
            ElseIf myalpha = "/" Then
            ActiveCell.Offset(0, i).Value = "   ++"
            ActiveCell.Offset(1, i).Value = "   ++"
            ActiveCell.Offset(2, i).Value = "++++++++"
            ActiveCell.Offset(3, i).Value = "   ++"
            ActiveCell.Offset(4, i).Value = "   ++"
       
        End If

End Function





Total Page Visits: 58 - Today Page Visits: 2

Leave a Reply