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