Nice opening screen with effects?

Hi,

Use the "Search" option above and search for:

Splash Screen

Setting it up
Follow these instructions to create a splash screen for your project.
1. Create your workbook as usual.
2. Activate the Visual Basic Editor and insert a new UserForm into the project. The code here assumes this form is named UserForm1.
3. Place any controls you like on UserForm1. For example, you may want to insert an Image control that has your company's logo. Also, you may want to set the UserForm's Caption property to an empty string.
4. Insert the following subroutine into the code module for the ThisWorkbook object:
Private Sub Workbook_Open()
UserForm1.Show
End Sub
5. Insert the following subroutine into the code module for UserForm1:
Private Sub UserForm_Activate()
Application.OnTime Now + TimeValue("00:00:05"), "KillTheForm"
End Sub
6. Insert the following subroutine into a normal VBA module:
Private Sub KillTheForm()
Unload UserForm1
End Sub

This gives moving text!

Sub AmiText()
'Run from Sheet Module.
'Will move text string to the right in a cell
'as a steped scroll "y" times.
Dim myText As String
Dim x As Integer, y As Integer
Dim myStart, myDelay
'Load the text to display & animate below here!
myText = " Animated Text!"
'Trap errors.
On Error GoTo myEnd
'Loop through the scrolling animation "y" times.
For y = 1 To 5
'"x" number of steps to the animation.
For x = 1 To 30
myStart = Timer
'This is how smooth or course to scroll right,
'the smaller the number the smoother the scroll.
myDelay = myStart + 0.1
Do While Timer < myDelay
'This is the cell to animate [Cell].
[D6] = Space(x) & myText
DoEvents
Loop
DoEvents
'Reset the timer as needed.
myStart = Timer
myDelay = myStart + 0.1
'Show the text string "x" times.
Next x
'Repeat this for "y" times.
Next y
'Reset the displayed text to blank.
[D6] = ""
'On Error End.
myEnd:
End
End Sub

Run code on workbook open.


Sub Worksheet_Activate()
'Sheet Module code!
'Runs code on workbook open.
Range("A1").Select
MsgBox "You have opened a blank WorkBook!"
End Sub

Add a custom message to the top of the Excel screen!

Sub MsgOnly()
'Add a message to the Excel Caption Bar at the top of the screen.
ActiveWindow.Caption = ""
Application.Caption = "You can add any message to this bar that you want! [ " & _
Worksheets("Sheet1").Range("D1").Value & " ] is the value of Cell D1."

End Sub

Add and remove color stars on screen!

Public Sub ShowStars()
Randomize
StarWidth = 50
StarHeight = 50
For i = 1 To 100
TopPos = Rnd() * (ActiveWindow.UsableHeight - StarHeight)
LeftPos = Rnd() * (ActiveWindow.UsableWidth - StarWidth)
Set NewStar = ActiveSheet.Shapes.AddShape _
(msoShape4pointStar, LeftPos, TopPos, StarWidth, StarHeight)
NewStar.Fill.ForeColor.SchemeColor = Int(Rnd() * 56)
Delay 0.01
DoEvents
Next i

Application.Wait Now + TimeValue("00:00:01")

Set myShapes = Worksheets(1).Shapes
For Each shp In myShapes
If Left(shp.Name, 9) = "AutoShape" Then
shp.Delete
Delay 0.01
End If
Next

End Sub
Public Sub Delay(rTime As Single)
'delay rTime seconds (min=.01, max=300)
Dim oldTime As Variant
'safety net
If rTime < 0.01 Or rTime > 300 Then rTime = 1
oldTime = Timer
Do
DoEvents
Loop Until Timer - oldTime > rTime

End Sub

You can record a macro as you remove, toolbars, frames, Row-Column ID's and other Excel trim. Then add it to your startup. Then your package will not look like Excel. Hope this helps. JSW

Screen Lable-Round-Edge-Boxes:

Sub Macro1()
'
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 61.5, 20.25, 515.25, _
50.25).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 2#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Adjustments.Item(1) = 0.3881
Selection.ShapeRange.Adjustments.Item(1) = 0.2538
ExecuteExcel4Macro "FORMULA(""=Sheet2!RC"")"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.AutoSize = False
End With
Range("A9").Select
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 90#, 120.75, 115.5, _
60.75).Select
Selection.ShapeRange.Adjustments.Item(1) = 0.2222
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 2#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
ExecuteExcel4Macro "FORMULA(""=Sheet2!R[1]C"")"
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.AutoSize = False
End With

ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 87#, 222.75, 117#, _
61.5).Select
Selection.ShapeRange.ScaleWidth 0.98, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.Adjustments.Item(1) = 0.2195
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 2#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
ExecuteExcel4Macro "FORMULA(""=Sheet2!R[2]C"")"
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.Orientation = xlHorizontal
.AutoSize = False
End With

Range("A1").Select
Application.CommandBars("Forms").Visible = True
ActiveSheet.Buttons.Add(309.75, 156.75, 172.5, 90.75).Select
Selection.OnAction = "Macro3"
Application.CommandBars("Forms").Visible = False
Selection.Characters.Text = "Press to" & Chr(10) & " ReSet Test"
With Selection.Characters(Start:=1, Length:=20).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 11
End With
Range("F8").Select
ActiveCell.FormulaR1C1 = "Note: Ballon data is located on Sheet2!"
Selection.Font.Bold = True
Range("A1").Select

End Sub
Sub Macro3()
'
Range("A1:A24").Select
Selection.EntireRow.Delete
Range("A1").Select

Application.CommandBars("Forms").Visible = True
ActiveSheet.Buttons.Add(190.75, 30.75, 204.5, 20).Select
Selection.OnAction = "Macro1"
Selection.ShapeRange.ScaleHeight 1.54, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleHeight 1.27, msoFalse, msoScaleFromTopLeft

With Selection.Characters(Start:=1, Length:=28).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
Selection.Characters.Text = "Press to build data ballons!"
Range("A1").Select
Application.CommandBars("Forms").Visible = False
End Sub

Sub OneB()
Range("A9").Select
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 90#, 120.75, 115.5, _
60.75).Select
Selection.ShapeRange.Adjustments.Item(1) = 0.2222
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 2#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

'Note: The message displayed is found in the cell address below!
'RC cell addresses start in row, column 0,0. So row 1 is row 2.
ExecuteExcel4Macro "FORMULA(""=Sheet2!R[1]C"")"
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.ColorIndex = 9
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.AutoSize = False
End With

'Set timer(Hour:Minutes:Seconds).
If Application.Wait(Now + TimeValue("0:00:10")) Then
Selection.Cut

End If
End Sub

Joe, everything seems to work fine and I got plenty of ideas to think about.

Regarding the "stars" code. Where do I apply changes to let the stars twinkle (apear and immediately disapear) and where do I find information about colour codes (the code includes "at random" but I want to select specific colours).

On 2002-10-28 15:33, Joe Was wrote:

You can record a macro as you remove, toolbars, frames, Row-Column ID's and other Excel trim. Then add it to your startup. Then your package will not look like Excel. Hope this helps. JSW

Click to expand...

Hi. I've been interested in removing *everything* around the Excel window making it look much like a GUI. How/where do I remove these? I haven't figured it out.
Thanks,
SteveC

Hi

SteveC

You can put excel to run in Kisok mode, if that help like in web page no EXCEL look, does that help??

Jack

Hi Jack,
Yes, if that's the only way: I'll have to try it and see how it looks. I'm assuming it won't affect how the spreadsheet works. I searched for Kisok and Kiosk but didn't find anything. How do you do it? Thanks
Steve

Hi Steve

bugger i cant remember now ?? Im a fool, ill remember and let you know, its easy enough but i cant remember sorry mate it will come to me.

LOL like you see sheets in email by selection or on teh web, just the same, not like turn off all tool bars and that,
Jack

Jack,
No problem. I'm in no hurry for this.
Thanks.
Steve


Oh yeah - I'll just keep looking for the "Turn Off Borders" button