Splashscreen

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Sooner or later, everyone wants to try making a splashscreen. Most that I seen so far seem be made with a userform, but I wanted to try making a very simple one using AutoShapes.



'Actually, this is a picture of two Autoshapes that have been grouped together. The Fill effects are Papyrus and Medium Wood, obtained from doube clicking the shapes while they are still separate and selecting Format AutoShape, Color and Lines, Fill Color, Fill Effects, Texture.

'Here's the code I used.

Sub SplashscreenShape()
Dim Ctr As Long
ThisWorkbook.Sheets("Sheet3").Activate
Range("A1:R41").Select
ActiveWindow.Zoom = True
Do While Ctr < 5
ActiveSheet.Shapes("Message").Select
Select Case Ctr
Case 0
Selection.Characters.Text = "CHANGE" & Chr(10) & "IT" & Chr(10) & "A" & Chr(10) & "BIT"
Case 1
Selection.Characters.Text = "WRITE" & Chr(10) & "ANYTHING" & Chr(10) & "YOU" & Chr(10) & "LIKE"
Case 2
Selection.Characters.Text = "DO" & Chr(10) & "IT" & Chr(10) & "FOR" & Chr(10) & "FUN"
Case 3
Selection.Characters.Text = "THIS" & Chr(10) & "IS" & Chr(10) & "THE" & Chr(10) & "END"
End Select
Ctr = Ctr + 1
Application.Wait Now + TimeSerial(0, 0, 2)
Loop
Application.ScreenUpdating = False
ActiveSheet.Shapes("Message").Select
Selection.Characters.Text = "PUT" & Chr(10) & "SOME" & Chr(10) & "TEXT" & Chr(10) & "HERE"
Range("IV65536").Select
ThisWorkbook.Sheets("Sheet1").Select
Application.ScreenUpdating = True
End Sub

Sub Auto_Open()
SplashscreenShape
End Sub

Sub Auto_Close()
ThisWorkbook.Close SaveChanges:=False
End Sub

'Note that I've used "ActiveWindow.Zoom". This is so the range A1:R41 is zoomed in or zoomed out automatically which helps the dimensions of the AutoShape to retain their proportions on different size screens.

Here's a sample workbook to download. Nothing brilliant, just something for my own amusement ;-)"