Excel VBA

css navigation by Css3Menu.com

Cute Greetings

Years ago, I had this idea for sending unique birthday greetings to a dear friend. I wrote this little ditty that walks a phrase down a page in a myriad of way.

I call the “GetText” code from a button on the front.

'+--------------------------------------------------
'|   Modules for creating a text file of cute Birthday greetings
'+--------------------------------------------------
'|   Enter the text and mac builds a series of characters dancing down the page
'+--------------------------------------------------

Option Base 1
'Declare Function GetTickCount Lib "kernel32" () As Long
'Dim lngTickCount As Long

Private Declare PtrSafe Function PlaySound Lib "winmm.dll" (ByVal lpszName As String, _
ByVal hModule As LongPtr, ByVal dwFlags As LongPtr) As LongPtr

Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000

'Table of Contents
    'Auto_Open
    'GetText
    'BuildSheet
    
'pw = "Good Morning"

Sub Auto_Open()
    Sheets("Main").Select
End Sub





Sub GetText()
    Dim Stringer As String, Incre As Integer, CounteR As Integer, InteraTe As Integer
    Dim Q As Integer, U As Integer, DaRow As String, Spacer, TheString As String
    Dim AnoRow As String, NamerS
    
    
    
    Spacer = Chr(32)
    InteraTe = 0
    Close #1
    TheString = InputBox("Type the phrase to be changed into a greeting ..." _
        & vbCrLf & vbCrLf & "For best results, do not use commas (,) in this input. Exclamations (!) are OK", _
        "Greeting Input", "Happy Birthday")
    Stringer = TheString
    Incre = Len(TheString)
    NamerS = ThisWorkbook.Path & "\" & Left(Stringer, 4) & Application.Text(Now(), "mmdd") & ".TXT"
  '  Open "c:\data\" & Left(Stringer, 4) & Application.Text(Now(), "mmdd") & ".TXT" For Output As #1
    Open NamerS For Output As #1
        For Q = 1 To Incre      '1st
            Stringer = Left(TheString, Q) & DaRow & Right(TheString, Len(TheString) - Q)
            DaRow = DaRow + Spacer
            Print #1, Stringer
        Next Q
        
        
        For U = 1 To Incre      '2nd
            Stringer = DaRow & TheString
                If DaRow = "" Then
                    DaRow = Chr(32)
                Else
                    DaRow = Left(DaRow, Len(DaRow) - 1)
                End If
            Print #1, Stringer
        Next
        For U = 1 To Incre      '3rd
            Stringer = Left(TheString, Len(TheString) - U) & DaRow & Right(TheString, U)
            Print #1, Stringer
            If DaRow = "" Then
                DaRow = Chr(32)
            Else
                DaRow = DaRow & Chr(32)
            End If
        Next U
        DaRow = Chr(32)
        '---------------------4th
        For Q = 1 To Incre      '4th
            Print #1, DaRow & Stringer
            DaRow = DaRow & Spacer
        Next Q
        AnoRow = DaRow
        DaRow = Chr(32)
        
        InteraTe = Len(TheString)       '5th
            Select Case Right(InteraTe, 1)
                Case 1, 3, 5, 7, 9
                    Stringer = TheString & DaRow
                Case 2, 4, 6, 8, 0
                    Stringer = TheString
            End Select
            U = Len(Stringer) / 2
        For Q = 1 To InteraTe
            Stringer = AnoRow & Left(TheString, U) & Left(DaRow, Len(AnoRow) + 1) & DaRow & Right(TheString, U)
            DaRow = DaRow + Spacer
            AnoRow = Right(AnoRow, Len(AnoRow) - 1)
       '         Debug.Print Stringer
            Print #1, Stringer
        Next Q
        For Q = 1 To InteraTe       '6th
            Stringer = AnoRow & Left(TheString, U) & Left(AnoRow, Len(DaRow) - 1) & DaRow & Right(TheString, U)
            Print #1, Stringer
            If DaRow = "" Then
                DaRow = Chr(32)
            Else
                DaRow = Right(DaRow, Len(DaRow) - 1)
            End If
            AnoRow = AnoRow + Spacer
        Next Q
        DaRow = Chr(32)
      Incre = Len(TheString)
        DaRow = Chr(32)
        For Q = 1 To Incre          '7th
            Stringer = Left(TheString, Q) & DaRow & Right(TheString, Len(TheString) - Q)
            DaRow = DaRow & Spacer
            Print #1, Stringer
        Next Q
        For Q = 1 To Incre          '7A
            Stringer = Left(TheString, Len(TheString) - Q) & DaRow & Right(TheString, Q)
            DaRow = Left(DaRow, Len(DaRow) - 1)
            Print #1, Stringer
        Next Q
        DaRow = ""
        For U = 1 To InteraTe       '8th
            Stringer = DaRow & TheString
                If DaRow = "" Then
                    DaRow = Chr(32)
                Else
                    DaRow = DaRow & Chr(32)
                End If
            Print #1, Stringer
        Next
        U = 0
        For U = 1 To InteraTe       '9th
            Stringer = DaRow & TheString
                If DaRow = "" Then
                    DaRow = Chr(32)
                Else
                    DaRow = Left(DaRow, Len(DaRow) - 1)
                End If
            Print #1, Stringer
        Next
        Print #1, DaRow; DaRow, TheString
    Close #1
    Dim strFile As String
    strFile = ThisWorkbook.Path & "\Marvin Question.wav"
    Call PlaySound(strFile, 0&, SND_ASYNC Or SND_FILENAME)
    
    MsgBox "The completed file is saved in " & NamerS & vbCrLf & _
        "Try changing the input to see different effects." & vbCrLf & vbCrLf _
        & "To send as an email, open the text file and copy the contents into the email message." _
        & " Alan is working on going directly to email.", 64, "Completed"
End Sub

Here is an example. I paste into an email and format accordingly.
Happy Birthday Joey
Ha ppy Birthday Joey
Hap  py Birthday Joey
Happ   y Birthday Joey
Happy     Birthday Joey
Happy      Birthday Joey
Happy B      irthday Joey
Happy Bi       rthday Joey
Happy Bir        thday Joey
Happy Birt         hday Joey
Happy Birth          day Joey
Happy Birthd           ay Joey
Happy Birthda            y Joey
Happy Birthday              Joey
Happy Birthday               Joey
Happy Birthday J               oey
Happy Birthday Jo                ey
Happy Birthday Joe                 y
Happy Birthday Joey                  
                   Happy Birthday Joey
                  Happy Birthday Joey
                 Happy Birthday Joey
                Happy Birthday Joey
               Happy Birthday Joey
              Happy Birthday Joey
             Happy Birthday Joey
            Happy Birthday Joey
           Happy Birthday Joey
          Happy Birthday Joey
         Happy Birthday Joey
        Happy Birthday Joey
       Happy Birthday Joey
      Happy Birthday Joey
     Happy Birthday Joey
    Happy Birthday Joey
   Happy Birthday Joey
  Happy Birthday Joey
 Happy Birthday Joey
Happy Birthday Joey
Happy Birthday Jo ey
Happy Birthday J  oey
Happy Birthday    Joey
Happy Birthday     Joey
Happy Birthda     y Joey
Happy Birthd      ay Joey
Happy Birth       day Joey
Happy Birt        hday Joey
Happy Bir         thday Joey
Happy Bi          rthday Joey
Happy B           irthday Joey
Happy             Birthday Joey
Happy              Birthday Joey
Happ              y Birthday Joey
Hap               py Birthday Joey
Ha                ppy Birthday Joey
H                 appy Birthday Joey
                  Happy Birthday Joey
                   Happy Birthday Joey
                    Happy Birthday Joey
                     Happy Birthday Joey
                      Happy Birthday Joey
                       Happy Birthday Joey
                        Happy Birthday Joey
                         Happy Birthday Joey
                          Happy Birthday Joey
                           Happy Birthday Joey
                            Happy Birthday Joey
                             Happy Birthday Joey
                              Happy Birthday Joey
                               Happy Birthday Joey
                                Happy Birthday Joey
                                 Happy Birthday Joey
                                  Happy Birthday Joey
                                   Happy Birthday Joey
                                    Happy Birthday Joey
                                     Happy Birthday Joey
                    Happy Birt  thday Joey
                   Happy Birt    thday Joey
                  Happy Birt      thday Joey
                 Happy Birt        thday Joey
                Happy Birt          thday Joey
               Happy Birt            thday Joey
              Happy Birt              thday Joey
             Happy Birt                thday Joey
            Happy Birt                  thday Joey
           Happy Birt                    thday Joey
          Happy Birt                      thday Joey
         Happy Birt                      thday Joey
        Happy Birt                      thday Joey
       Happy Birt                      thday Joey
      Happy Birt                      thday Joey
     Happy Birt                      thday Joey
    Happy Birt                      thday Joey
   Happy Birt                      thday Joey
  Happy Birt                      thday Joey
 Happy Birt                     thday Joey
  Happy Birt                     thday Joey
   Happy Birt                     thday Joey
    Happy Birt                     thday Joey
     Happy Birt                     thday Joey
      Happy Birt                     thday Joey
       Happy Birt                     thday Joey
        Happy Birt                     thday Joey
         Happy Birt                     thday Joey
          Happy Birt                     thday Joey
           Happy Birt                   thday Joey
            Happy Birt                 thday Joey
             Happy Birt               thday Joey
              Happy Birt             thday Joey
               Happy Birt           thday Joey
                Happy Birt         thday Joey
                 Happy Birt       thday Joey
                  Happy Birt     thday Joey
                   Happy Birt   thday Joey
H appy Birthday Joey
Ha  ppy Birthday Joey
Hap   py Birthday Joey
Happ    y Birthday Joey
Happy      Birthday Joey
Happy       Birthday Joey
Happy B       irthday Joey
Happy Bi        rthday Joey
Happy Bir         thday Joey
Happy Birt          hday Joey
Happy Birth           day Joey
Happy Birthd            ay Joey
Happy Birthda             y Joey
Happy Birthday               Joey
Happy Birthday                Joey
Happy Birthday J                oey
Happy Birthday Jo                 ey
Happy Birthday Joe                  y
Happy Birthday Joey                   
Happy Birthday Joe                    y
Happy Birthday Jo                   ey
Happy Birthday J                  oey
Happy Birthday                  Joey
Happy Birthday                 Joey
Happy Birthda               y Joey
Happy Birthd              ay Joey
Happy Birth             day Joey
Happy Birt            hday Joey
Happy Bir           thday Joey
Happy Bi          rthday Joey
Happy B         irthday Joey
Happy         Birthday Joey
Happy        Birthday Joey
Happ      y Birthday Joey
Hap     py Birthday Joey
Ha    ppy Birthday Joey
H   appy Birthday Joey
  Happy Birthday Joey
Happy Birthday Joey
 Happy Birthday Joey
  Happy Birthday Joey
   Happy Birthday Joey
    Happy Birthday Joey
     Happy Birthday Joey
      Happy Birthday Joey
       Happy Birthday Joey
        Happy Birthday Joey
         Happy Birthday Joey
          Happy Birthday Joey
           Happy Birthday Joey
            Happy Birthday Joey
             Happy Birthday Joey
              Happy Birthday Joey
               Happy Birthday Joey
                Happy Birthday Joey
                 Happy Birthday Joey
                  Happy Birthday Joey
                   Happy Birthday Joey
                  Happy Birthday Joey
                 Happy Birthday Joey
                Happy Birthday Joey
               Happy Birthday Joey
              Happy Birthday Joey
             Happy Birthday Joey
            Happy Birthday Joey
           Happy Birthday Joey
          Happy Birthday Joey
         Happy Birthday Joey
        Happy Birthday Joey
       Happy Birthday Joey
      Happy Birthday Joey
     Happy Birthday Joey
    Happy Birthday Joey
   Happy Birthday Joey
  Happy Birthday Joey
 Happy Birthday Joey
              Happy Birthday Joey


Hope you like it and check out the sample.

© MMXVIII

Updated:  06/01/2018 16:55
This page added:  01 June 2018