Splash Screen Errors

Option Explicit
'// This Userform code has everything you need to make a captionless userform
'// Fade In & Out


'// Transparency
Private Declare Function SetLayeredWindowAttributes _
    Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal crKey As Long, _
        ByVal bAlpha As Byte, _
        ByVal dwFlags As Long) _
As Long


'// Title Bar
Private Declare Function GetWindowRect _
    Lib "user32" ( _
        ByVal hWnd As Long, _
        lpRect As RECT) _
As Long
   
Private Declare Function SetWindowLong _
    Lib "user32" _
        Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) _
As Long


Private Declare Function GetWindowLong _
    Lib "user32" _
        Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) _
As Long
   
'// Win Styles
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_STYLE = (-16)


Private Const WS_EX_LAYERED = &H80000
Private Const WS_CAPTION = &HC00000            ' WS_BORDER Or WS_DLGFRAME
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SYSMENU = &H80000


'// Trans
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const ULW_COLORKEY = &H1
Private Const ULW_ALPHA = &H2
Private Const ULW_OPAQUE = &H4


'// Used for moving Captionless form
Private Declare Function SetWindowPos _
    Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal hWndInsertAfter As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal cx As Long, _
        ByVal cy As Long, _
        ByVal wFlags As Long) _
As Long


Private Declare Function SendMessage _
    Lib "user32" _
        Alias "SendMessageA" ( _
            ByVal hWnd As Long, _
            ByVal wMsg As Long, _
            ByVal wParam As Long, _
            lParam As Any) _
As Long


 
Private Declare Function FindWindowA _
    Lib "user32" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) _
As Long
  
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOOWNERZORDER = &H200    ' Don't do owner Z ordering
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Private Const HWND_NOTOPMOST = -2


Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type


Private lResult As Long
Private frmHdl As Long
Private blnTitleVisible As Boolean
Private blnCtrlShow As Boolean


Private lFrmHdl  As Long


Private Sub Label1_Click()


End Sub


''
Private Sub UserForm_Activate()
Application.Visible = False


'// Main routines


    Application.Wait (Now + TimeValue("0:00:02"))
    Call FadeOut(256 * 4)
    Application.Wait (Now + TimeValue("0:00:01"))
    Call FadeIn(256 * 4)
    Application.Wait (Now + TimeValue("0:00:20"))


Application.Visible = True
End Sub


Private Sub UserForm_Initialize()
    '// Ivan F Moala
    lFrmHdl = FindWindowA(vbNullString, Me.Caption)
    ShowTitleBar False
    '// Need this call 1st to set > No Flicker
    MakeTransparent (255)
    KillTheForm
End Sub


'// MODIFIED: Ivan F Moala 2/6/2002
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    '// Leave this here as your backdoor, incase you have NO CLOSE BUTTON
    Unload Me
    Application.Visible = True
End Sub




'// Handles the Userform Title
Private Function ShowTitleBar(ByVal bState As Boolean)
Dim lStyle As Long
Dim tR As RECT


'// Get the window's position:
GetWindowRect lFrmHdl, tR


'// Modify whether title bar will be visible:
lStyle = GetWindowLong(lFrmHdl, GWL_STYLE)
    '
 If Not bState Then
    lStyle = lStyle And Not WS_SYSMENU
    lStyle = lStyle And Not WS_MAXIMIZEBOX
    lStyle = lStyle And Not WS_MINIMIZEBOX
    lStyle = lStyle And Not WS_CAPTION
    blnTitleVisible = True
Else
    lStyle = lStyle Or WS_SYSMENU
    lStyle = lStyle Or WS_MAXIMIZEBOX
    lStyle = lStyle Or WS_MINIMIZEBOX
    lStyle = lStyle Or WS_CAPTION
    blnTitleVisible = False
End If


SetWindowLong lFrmHdl, GWL_STYLE, lStyle


'// Ensure the style takes and make the window the
'// same size, regardless that the title bar
'// is now a different size:
SetWindowPos lFrmHdl, 0, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _
    SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED
'Me.Repaint


End Function


'// Transparency routines
Private Sub FadeIn(Fin As Long)
Dim X As Long


X = 0
Do Until X = Fin
    DoEvents
    X = X + 1
    MakeTransparent X / 2
Loop


End Sub


Private Function FadeOut(Fin As Long)
Dim Y As Long
    
Y = Fin
    
Do Until Y = 0
    DoEvents
    Y = Y - 1
    Call MakeTransparent(Y / 2)
Loop


End Function


Private Function MakeTransparent(lIndex As Long) As Long


On Error Resume Next
If lIndex < 0 Or lIndex > 255 Then
    MakeTransparent = 0 '1
Else
    lResult = GetWindowLong(lFrmHdl, GWL_EXSTYLE)
    lResult = lResult Or WS_EX_LAYERED
    SetWindowLong lFrmHdl, GWL_EXSTYLE, lResult
    SetLayeredWindowAttributes lFrmHdl, 0, lIndex, LWA_ALPHA
    MakeTransparent = 0
End If


If Err Then MakeTransparent = 2


End Function


Private Sub KillTheForm()
    Unload SplashScreen
End Sub