Viele professionelle Anwendungen verwenden einen sogenannten Splash-Screen beim Programmstart, um z.B. den Initialisierungsstatus der Anwendung oder Infos zum registrierten Benutzer bzw. Entwicklern anzuzeigen. In diesem Tutorial werden wir Schritt für Schritt einen Splash Screen in Excel VBA implementieren.
Dieses Tutorial richtet sich primär an Personen, die bereits Erfahrungen in VBA sammeln konnten. Der Splash Screen sollte für alle Excel Versionen ab Excel 2000 funktionieren.
2. Vorbereitungen
Öffnen Sie Excel und legen Sie eine Datei an, nennen wir diese mal Splash.xls. Löschen Sie alle Tabellen, bis auf eine. Lassen Sie uns nun die verbliebene Tabelle in Copyright umbenennen. Sie können diese Tabelle auch nach Belieben formatieren.
Öffnen Sie nun den VBA Editor, blenden Sie den Projekt-Explorer, das Eigenschaftsfenster und den Direktbereich ein. Fügen Sie nun zwei neue Module in ihr Projekt ein. Benennen Sie diese Module in MLP_Api und MLP_Run um. Nun, warum zwei Module? Eines werden wir globale allgemeine Funktionen nutzen und eines zum Import von Windows API-Funktionen. Fügen Sie dem Projekt nun eine Userform hinzu und benennen Sie diese in MLF_Splash um. Speichern Sie die Datei.
3. Die Userform MLF_Splash
Diese Userform wird den Splash Screen implementieren. Was brauchen wir dafür? Nun, zunächst ein Hintergrundbild, dann ein paar Infos über die Anwendung und eine Statusabfrage. Wenn's professionell sein soll, wären auch Infos zum Benutzer, der Firma und der Lizenz auch nicht schlecht.
In einem ersten Schritt, weisen Sie der Eigenschaft Caption im Eigenschaftsfenster den Wert 'Splash' zu - das ist wichtig, später brauchen wir das noch..
Erstellen Sie nun ein Anzeige-Steuerelement und weisen Sie der Eigenschaft Picture ein Bild zu. Das Bild sollte als Bitmap vorliegen. Fügen Sie anschließend folgende Bezeichnungsfelder mit den entsprechenden Benennungen ein…
- Für den Anwendungsnamen das Feld STC_Title
- Für Versionsinformationen das Feld STC_Version
- Für Copyright-Informationen das Feld STC_Copyright
- Für den Benutzernamen das Feld STC_User
- Für den Firmennamen das Feld STC_Company
- Für die Seriennummer das Feld STC_Serial
- Für den Lizensierungsstatus das Feld STC_State
- Für die Prozentanzeige das Feld STC_Percent
- Für Meldungen während des Ladens das Feld STC_Loading
Fügen Sie weitere Bezeichnungsfelder ein, z.B. zur Kennzeichnung der zuvor genannten Felder. Positionieren Sie ihre Felder. In etwa könnte die Userform nun so aussehen.
Fügen Sie jetzt zwei Schaltflächen ein und benennen Sie diese jeweils BTN_Abort und BTN_Continue. Diese Buttons dienen später beispielsweise später dazu, den Ladevorgang abzubrechen oder nach einem Hinweis fortzusetzen. Insofern setzen Sie bitte die Schaltflächentexte beispielsweise auf 'Weiter' und 'Abbrechen'. Sie könnten den Buttons auch über die Eigenschaft Picture kleine Bitmaps zuweisen.
4. Der Code zur Userform
Im Folgenden der Code zur Userform. Sie können den Code herauskopieren und in das Codemodul zu Ihrer Userform einfügen.
' Copyright : 2005-2007 by Maninweb.de ' .............................................................................. ' Types & Vars ' .............................................................................. ' Steps... Private mlvhStep As Long ' Events ' .............................................................................. ' Buttons... Private Sub BTN_Abort_Click() ' Result... mlvpRunResult = 0 ' Unload... Unload Me End Sub Private Sub BTN_Continue_Click() ' Continue... mlfhStep mlvhStep End Sub ' Form... Private Sub UserForm_Activate() mlfhStep 0 End Sub Private Sub UserForm_Initialize() ' Size... Me.Height = 214 - 16 Me.Width = 420 ' Load... mlfhLoad End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode < 1 Then Cancel = True End If End Sub ' Functions ' .............................................................................. Private Function mlfhLoad() As Long Dim n As Long Dim s As String ' Disable errors... On Error Resume Next ' Buttons... BTN_Abort.Visible = False BTN_Continue.Visible = False BTN_Abort.TakeFocusOnClick = False BTN_Continue.TakeFocusOnClick = False ' Initialize... STC_Percent.Caption = "0 %" STC_Loading.Caption = "" STC_Title.Caption = "Anwendungstitel" STC_Version.Caption = "Version " & CStr(1) & "." & _ Format(0, "00") & " - " & "Build " & CStr(1000) STC_Copyright.Caption = "Copyright 2005-2007 by www.maninweb.de" STC_User.Caption = "" STC_Company.Caption = "" STC_Serial.Caption = "" STC_State.Caption = "" ' Return... mlfhLoad = 0 End Function Private Function mlfhStep(Step As Long) As Long Dim r As Long ' Disable errors... On Error Resume Next ' Events... DoEvents ' Set... mlvhStep = Step ' Loop... Do ' Reset... r = 0 ' Increase... mlvhStep = mlvhStep + 1 ' Progress... STC_Percent.Caption = Format(mlvhStep, "00") & " %" ' Events... DoEvents ' Select... Select Case mlvhStep Case 1 ' Caption... STC_Loading.Caption = "Anwendung wird initialisiert..." ' Events... DoEvents ' Data... STC_User.Caption = "Maninweb" STC_Company.Caption = "maninweb.de" STC_Serial.Caption = "A5DE - 76EB - 3ACD - 9FFC" STC_State.Caption = "Registriert" ' Events... DoEvents Case 5 ' Caption... STC_Loading.Caption = "Lade globale Einstellungen..." ' Events... DoEvents Case 10 ' Caption... STC_Loading.Caption = "Prüfe Lizenzdaten..." ' Events... DoEvents Case 11 ' Check license... Select Case mlfpRunLicense Case 0 ' Demo ' Caption... STC_Loading.Caption = "Demo noch " & CStr(10) & " Tage gültig..." ' Events... DoEvents ' Result... r = 2 Case 1 ' Registred ' Nothing Case Else ' Invalid ' Caption... STC_Loading.Caption = "Ungültige Lizenz oder Demo abgelaufen..." ' Events... DoEvents ' Result... r = 1 End Select Case 20 ' Caption... STC_Loading.Caption = "Prüfe..." ' Events... DoEvents Case 30 ' Caption... STC_Loading.Caption = "Prüfe..." ' Events... DoEvents Case Else End Select Loop While CBool(mlvhStep < 100) And CBool(r < 1) ' Check... If CBool(r <> 0) Then ' Select... Select Case r Case 1 ' Abort BTN_Abort.Visible = True Case 2 ' Continue BTN_Continue.Visible = True Case Else ' Nothing End Select Else ' Result... mlvpRunResult = 1 ' Events... DoEvents ' Unload... Unload Me End If End Function
Bei der Initialisierung der Userform wird zunächst diese auf eine feste Größe gesetzt, dann werden durch den Aufruf von mlfhLoad() die Bezeichnungsfelder gefüllt; und zwar bevor die Userform auf dem Bildschirm erscheint. Beim Ereignis UserForm_Activate() zur Anzeige der Userform wird die Funktion mlfhStep() aufgerufen. Diese führt nun eine Schleife aus, wo weitere Aktionen innerhalb der Select Case Anweisungen ausgeführt werden. Ein Beispiel hierfür ist der Aufruf der Funktion mlfpRunLicense() zur Validierung einer Lizenz.
Sie könnten an dieser Stelle eigene Funktionen aufrufen oder auch die Anzahl der abgefangenen Werte ergänzen. Die globale Variable mlvpRunResult merkt sich die Aktion, die nach Beendigung des Splash-Screens ausgeführt werden soll.
5. Das Modul MLP_Run
Wie zuvor schon erwähnt, nutzt das Programm globale Variablen zur Steuerung. Diese sind in dem Modul MLP_Run definiert. Zudem finden Sie hier die Funktion, die den Splash Screen startet. Fügen Sie den Code hier unten in das Modul MLP_Run ein.
' Copyright : 2005-2007 by Maninweb.de ' .............................................................................. Option Private Module ' Types & Vars ' .............................................................................. ' State... Public mlvpRunResult As Long ' Public functions ' .............................................................................. ' License... Public Function mlfpRunLicense() As Long Dim r As Long ' Disable errors... On Error Resume Next ' Result... ' ' 0 = Demo ' 1 = Registriert ' X = Invalid r = CLng(ThisWorkbook.Worksheets(1).Cells(1, 26).Value) ' Return... mlfpRunLicense = r End Function ' Run... Public Function mlfpRun() As Long Dim h As Long Dim n As Long Dim p As Long Dim r As String ' Disable errors... On Error Resume Next ' Show... MLF_Splash.Show ' Result... If mlvpRunResult < 1 Then ' Terminate... MsgBox "Anwendung wieder beenden !" End If ' Return... mlfpRun = CStr(mlvpRunResult) End Function
6. Testen des Splash-Screens
Nun wird's Zeit mal den Splash Screen zu testen. Geben Sie im Direktfenster mlfpRun ein und drücken Sie die Enter-Taste. Nett, oder? Es sollte sich der Splash Screen laden und die Prozentanzeige bei 11 stehen bleiben sowie die Schaltfläche erscheinen, die Sie zuvor als 'Abbrechen' gekennzeichnet haben. Wenn Sie diese anklicken, erhalten Sie eine Nachricht, dass die Lizenz nicht validiert werden konnte.
Lassen Sie uns nun einen weiteren Fall testen. Wechseln Sie zu Excel und geben Sie in der ersten Tabelle in der Zelle AA1 eine 1 ein sowie in Zelle Z1 die Formel =AA1-1. Rufen Sie den Splash Screen erneut auf. Diesmal erscheint der 'Weiter' Button. Wenn Sie den anklicken, wird der Splash Screen weitergeführt. Also prima für den Fall, wo der User noch Zeit hätte das Programm zu registrieren.
Geben Sie nun in AA1 ein 2 ein und testen Sie das Ganze erneut. Der Splash Screen läuft jetzt durch und beendet sich selbst.
Haben Sie übrigens festgestellt, dass dieser sehr schnell ist, also kaum Zeit verbleibt, die Texte zu lesen. Und stört nicht die Titelleiste?
7. Das Modul MLP_Api
Das Windows API - Application Program Interface - wird uns helfen, eine Zeitverzögerung einzubauen und die Titelleiste zu entfernen. Windows bietet in seinem Kernel schon alles was man dafür braucht. Diese Funktionen können auch von eigenen Programmen aufgerufen werden. Dafür muss die angeforderte Funktion importiert werden.
Aber seien Sie gewarnt: wenn Sie Funktionen importieren und nicht wissen, was Sie tun, kann Ihr Rechner dabei abstürzen. Testen Sie also den Aufruf von API-Funktionen niemals ohne andere Programme und Daten geschlossen zu haben.
Sie benutzen also folgenden Teil auf Ihr eigenes Risiko hin. Kopieren Sie zunächst folgenden Code in das Modul MLP_Api
' Copyright : 2005-2007 Maninweb.de ' .............................................................................. Option Explicit ' Constants ' .............................................................................. ' Window constants... Public Const mlcpApiWndTopmost As Long = -1 Public Const mlcpApiWndNotTopmost As Long = -2 Public Const mlcpApiSwpNoMove As Long = &H2 Public Const mlcpApiSwpNoSize As Long = &H1 Public Const mlcpApiSwpNoActivate As Long = &H10 Public Const mlcpApiSwpShowWindow As Long = &H39 Public Const mlcpApiSwpTopmostFlags As Long = mlcpApiSwpNoMove Or _ mlcpApiSwpNoSize ' Window style constants... Public Const mlcpApiWsBorder As Long = &H800000 Public Const mlcpApiWsCaption As Long = &HC00000 Public Const mlcpApiWsChild As Long = &H39000000 Public Const mlcpApiWsClipChildren As Long = &H2000000 Public Const mlcpApiWsClipSiblings As Long = &H3900000 Public Const mlcpApiWsDisabled As Long = &H8000000 Public Const mlcpApiWsDialogFrame As Long = &H390000 Public Const mlcpApiWsGroup As Long = &H20000 Public Const mlcpApiWsHScroll As Long = &H100000 Public Const mlcpApiWsMaximize As Long = &H1000000 Public Const mlcpApiWsMaximizeBox As Long = &H10000 Public Const mlcpApiWsMinimize As Long = &H20000000 Public Const mlcpApiWsMinimizeBox As Long = &H20000 Public Const mlcpApiWsOverlapped As Long = &H0& Public Const mlcpApiWsPopup As Long = &H80000000 Public Const mlcpApiWsSystemMenu As Long = &H80000 Public Const mlcpApiWsTabStop As Long = &H10000 Public Const mlcpApiWsThickFrame As Long = &H39000 Public Const mlcpApiWsVisible As Long = &H10000000 Public Const mlcpApiWsVScroll As Long = &H200000 Public Const mlcpApiWsOverWindow As Long = (mlcpApiWsOverlapped Or _ mlcpApiWsCaption Or _ mlcpApiWsSystemMenu Or _ mlcpApiWsThickFrame Or _ mlcpApiWsMinimizeBox Or _ mlcpApiWsMaximizeBox) Public Const mlcpApiWsPopupWindow As Long = (mlcpApiWsPopup Or _ mlcpApiWsBorder Or _ mlcpApiWsSystemMenu) ' Window style type constants... Public Const mlcpApiGwlExtendedStyle As Long = (-20) Public Const mlcpApiGwlInstance As Long = (-6) Public Const mlcpApiGwlParentWindow As Long = (-8) Public Const mlcpApiGwlIdentity As Long = (-12) Public Const mlcpApiGwlStyle As Long = (-16) Public Const mlcpApiGwlUserData As Long = (-21) Public Const mlcpApiGwlWindowProc As Long = (-4) ' Imported API functions ' .............................................................................. ' Imported API Functions from Kernel32... Private Declare _ Sub mlfhSleep _ Lib "kernel32" _ Alias "Sleep" (ByVal a As Long) Private Declare _ Function mlfhSleepEx _ Lib "kernel32" _ Alias "SleepEx" (ByVal a As Long, _ ByVal b As Long) As Long ' Imported API Functions from User32... Private Declare _ Function mlfhDrawMenuBar _ Lib "user32" _ Alias "DrawMenuBar" (ByVal a As Long) As Long Private Declare _ Function mlfhFindWindow _ Lib "user32" _ Alias "FindWindowA" (ByVal a As Any, _ ByVal b As String) As Long Private Declare _ Function mlfhGetWindowLong _ Lib "user32" _ Alias "GetWindowLongA" (ByVal a As Long, _ ByVal b As Long) As Long Private Declare _ Function mlfhSetWindowLong _ Lib "user32" _ Alias "SetWindowLongA" (ByVal a As Long, _ ByVal b As Long, _ ByVal c As Long) As Long ' Functions ' .............................................................................. ' Draw... Public Function mlfpApiDrawMenuBar(Handle As Long) As Long mlfpApiDrawMenuBar = mlfhDrawMenuBar(Handle) End Function ' Find window... Public Function mlfpApiFindWindow(Caption As String) As Long mlfpApiFindWindow = mlfhFindWindow(0&, Caption) End Function ' Get window long... Public Function mlfpApiGetWindowLong(Handle As Long, _ Index As Long) As Long mlfpApiGetWindowLong = mlfhGetWindowLong(Handle, Index) End Function ' Set window long... Public Function mlfpApiSetWindowLong(Handle As Long, _ Index As Long, _ Value As Long) As Long mlfpApiSetWindowLong = mlfhSetWindowLong(Handle, Index, Value) End Function ' Wait... Public Function mlfpApiWait(Duree As Long) As String Dim n As Long ' Disable errors... On Error Resume Next ' Time... n = Duree ' Sleep... mlfhSleep n ' Return... mlfpApiWait = CStr(0) End Function
mlfpApiWait(Duree As Long) ruft die passende API Funktion auf, um das Programm um 'Duree' zu verzögern, Angabe in Millisekunden. Die anderen API Funktionen werden kombiniert werden, um die blaue Titelleiste der Userform zu entfernen.
8. Ändern des Codes zur Userform
Fügen Sie als ersten Schritt folgende Funktion am Ende des Code zu Ihrer Userform ein, also hinter mlfhStep().
' Style... Private Function mlfhStyle(Optional Redraw As Boolean = False) As Long Dim p As Long Dim h As Long ' Disable errors... On Error Resume Next ' Get handle... h = mlfpApiFindWindow(Me.Caption) ' Check... If CBool(h <> 0) Then ' Get style... p = mlfpApiGetWindowLong(h, mlcpApiGwlStyle) ' Kill caption bar... p = p And Not mlcpApiWsCaption ' Set new style... mlfpApiSetWindowLong h, mlcpApiGwlStyle, p ' Redraw... If Redraw Then mlfpApiDrawMenuBar h End If End If End Function
Sie sehen, hier wird zunächst über h = mlfpApiFindWindow(Me.Caption) das Handle der Userform abgefragt; deshalb ist die Angabe des Titels wichtig. Anschließend werden Fensterstati abgefragt, verändert und wieder gesetzt. Wenn nötig, soll ein Neuzeichnen erzwungen werden. Nun müssen wir diese Funktion im Aufruf der Userform einfügen, also UserForm_Initialize() modifizieren.
Private Sub UserForm_Initialize() ' Size... Me.Height = 214 - 16 Me.Width = 420 ' Load... mlfhLoad ' Set window style... mlfhStyle True End Sub
So, jetzt haben wir's fast geschafft. Es fehlt nur noch die Verzögerung, die wir in jedem Zweig der Select Case Anweisung einbauen können, beispielhaft...
Case 5 ' Caption... STC_Loading.Caption = "Lade globale Einstellungen..." ' Events... DoEvents ' Wait... mlfpApiWait 250 Case 10 ' Caption... STC_Loading.Caption = "Prüfe Lizenzdaten..." ' Events... DoEvents ' Wait... mlfpApiWait 250 Case 11
Sie können auch ruhig weitere einbauen. Bleibt nur noch die Userform zu testen. Speichern Sie zunächst die Datei und rufen Sie die Userform, wie schon gezeigt, über das Direktfenster auf. Schön, nicht wahr?
9. Abschluss
Sie können jetzt zum Abschluß noch eine Schaltfläche aus der Formularsymbolleiste in die erste Tabelle einfügen und mit dem Makro mlfpRun() verknüpfen oder auch eine Liste erstellen, um die Zelle AA1 automatisch zu füllen.
Beachten Sie, dass die Lizenzabfrage nicht die Sicherheit Ihrer Anwendung erhöht, VBA Dateien sind und bleiben einfach zu cracken.
Wir hoffen, dass Ihnen dieses Tutorial gefallen hat. Schreiben Sie uns Ihre Meinung oder auch Kritik und Anregungen an .
Neuigkeiten
Blog
