AW: Splash screen
14.06.2018 13:02:14
Eisi
Vielleicht den Code noch, damit man einen Blick drauf werfen kann:
Diese Arbeitsmappe:
Option Explicit
Private Sub Workbook_Open()
Call Init
End Sub
frmSplashScreen:
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SYSMENU = &H80000
Private wHandle As Long
Private Sub UserForm_Activate()
Me.Repaint
Call SetInitValues
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim lStyle As Long
Dim frm As Long
If Val(Application.Version) >= 9 Then
wHandle = FindWindow("ThunderDFrame", Me.Caption)
Else
wHandle = FindWindow("ThunderXFrame", Me.Caption)
End If
If wHandle = 0 Then Exit Sub
lStyle = GetWindowLong(wHandle, GWL_STYLE)
Me.Caption = ""
lStyle = lStyle And Not WS_SYSMENU
lStyle = lStyle And Not WS_MAXIMIZEBOX
lStyle = lStyle And Not WS_MINIMIZEBOX
lStyle = lStyle And Not WS_CAPTION
SetWindowLong wHandle, -20, frm
SetWindowLong wHandle, GWL_STYLE, lStyle
DrawMenuBar wHandle
Me.Width = Image1.Width
Me.Height = Image1.Height
Me.StartUpPosition = 3 ' Bildschrimmitte 2
End Sub
Public Sub Progress(ByVal intMode As Integer, Optional ByVal sngStep As Single, Optional ByVal _
lngCnt As Long)
Static ssngS As Single, ssngStep As Single
Static slngCnt As Long, ssngWidth As Single
If intMode = 1 Then ' Run
ssngS = ssngS + ssngStep
fraProgress.Width = (ssngS / slngCnt) * ssngWidth
ElseIf intMode = 0 Then ' Init
slngCnt = lngCnt
ssngStep = sngStep
ssngWidth = fraProgress.Width
ElseIf intMode = 2 Then ' Reset
ssngS = 0
ssngStep = 0
slngCnt = 0
ssngWidth = 0
fraProgress.Width = 0
End If
End Sub
Modul1:
Option Explicit
Public Sub Init()
Load frmSplashScreen
With frmSplashScreen
.Top = Application.Top + (Application.Height - .Height) / 2
.Left = Application.Left + (Application.Width - .Width) / 2
End With
frmSplashScreen.Show
End Sub
Sub Auto_Open()
Load frmSplashScreen
End Sub
Public Sub SetInitValues()
Dim i As Long
Dim k As Long
Const c As Long = 10 ^ 5
Application.ScreenUpdating = False
Call frmSplashScreen.Progress(0, 100, c)
For i = c To 1 Step -1
Tabelle1.Cells(c - i + 1, 1).Value = i
If i Mod 100 = 0 Then Call frmSplashScreen.Progress(1)
Next
Call frmSplashScreen.Progress(2)
Application.ScreenUpdating = True
End Sub
Tabelle1 (Codeblatt)
Hier wird automatisch eine Zahlenkolonne in die Spalte A geschrieben.