title image


Smiley Re: So könnte es gehen...
Erstelle ein Standardmodul mit folgendem Inhalt:Option Explicit Public Function MsgBox _( _ Prompt, _ Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _ Optional Title, _ Optional HelpFile, _ Optional Context, _ Optional TimeOut _) As VbMsgBoxResult ' Diese Funktion ersetzt die Visual Basic MsgBox. ' Wenn der Optionale Parameter TimeOut nicht angegeben wurde, wird die ' Standard-Messagebox aufgerufen - ansonsten eine eigene Form If IsMissing(TimeOut) Then ' Da TimeOut nicht angegeben wurde, wird die VB-MessageBox verwendet. If IsMissing(HelpFile) Or IsMissing(Context) Then MsgBox = VBA.Interaction.MsgBox(Prompt, Buttons, Title, HelpFile, Context) ElseIf Len(HelpFile) > 0 And Len(Context) > 0 Then MsgBox = VBA.Interaction.MsgBox(Prompt, Buttons Or vbMsgBoxHelpButton, Title, HelpFile, Context) Else MsgBox = VBA.Interaction.MsgBox(Prompt, Buttons, Title, HelpFile, Context) End If Else Dim FRM As Form Set FRM = MeineMsgBoxForm MsgBox = FRM.ShowMsg(Prompt, Buttons, Title, HelpFile, Context, TimeOut) End IfEnd FunctionDann erstellst Du ein Formular und nennst es "MeineMsgBoxForm".Das Formular benötigt folgende Steuerelemente: 4 Schaltflächen als Array: cmdButton(0) bis cmdButton(3), alle unsichtbar, Beschriftung egal. 4 Image-Steuerelemente: imgIcon(0) bis imgIcon(3), alle unsichtbar, sollen die Icons Ausruungszeichen, Fragezeichen usw. enthalten. 1 Bezeichnungsfeld: lblPrompt, AutoSize = True, sichtbar. 1 Timer-Steuerelement: timDefault, DISABLED(!), Interval = 0Das Formular benötigt folgenden Code:Option Explicit'' Falls die Hilfefunktion implementiert werden soll:' Commands to pass WinHelp()Private Const HELP_CONTEXT = &H1 ' Display topic in ulTopicPrivate Const HELP_QUIT = &H2 ' Terminate helpPrivate Const HELP_INDEX = &H3 ' Display indexPrivate Const HELP_CONTENTS = &H3&Private Const HELP_HELPONHELP = &H4 ' Display help on using helpPrivate Const HELP_SETINDEX = &H5 ' Set current Index for multi index helpPrivate Const HELP_SETCONTENTS = &H5&Private Const HELP_CONTEXTPOPUP = &H8&Private Const HELP_FORCEFILE = &H9&Private Const HELP_KEY = &H101 ' Display topic for keyword in offabDataPrivate Const HELP_COMMAND = &H102&Private Const HELP_PARTIALKEY = &H105&Private Const HELP_MULTIKEY = &H201&Private Const HELP_SETWINPOS = &H203&Declare Function WinHelp Lib "user32" Alias "WinHelpA" _( _ ByVal hwnd As Long, _ ByVal lpHelpFile As String, _ ByVal wCommand As Long, _ ByVal dwData As Long _) As Long Dim mNoButtons As Integer ' Anzahl der ButtonsDim mRetValue As VbMsgBoxResult ' RückgabewertDim mHelpFile As StringDim mHelpContext As Long Public Function ShowMsg(Prompt, Buttons, Title, HelpFile, Context, TimeOut) As VbMsgBoxResult Dim i As Integer Const ButtonMask = &H7& Const IconMask = &H70& Const DefaultButtonMask = &H300& ' ' Schaltflächen darstellen und beschriften: ' If IsMissing(Buttons) Then ' Kein Button-Parameter angegeben: Nur OK-Schaltfläche mNoButtons = 1 cmdButton(0).Caption = "&OK" cmdButton(0).Visible = True cmdButton(0).Tag = vbOK mRetValue = vbOK Me.Show ' Warum Show und Hide wird weiter unten erläutert. cmdButton(0).SetFocus Me.Hide Else Select Case Buttons And ButtonMask Case vbOKCancel ' = 1 mNoButtons = 2 ' 2 Schaltflächen werden benötigt cmdButton(0).Caption = "&OK" cmdButton(0).Tag = vbOK cmdButton(1).Caption = "&Abbrechen" cmdButton(1).Tag = vbCancel Case vbAbortRetryIgnore ' = 2 mNoButtons = 3 ' 3 Schaltflächen werden benötigt cmdButton(0).Caption = "&Abbrechen" cmdButton(1).Tag = vbAbort cmdButton(1).Caption = "&Widerholen" cmdButton(1).Tag = vbRetry cmdButton(2).Caption = "&Ignorieren" cmdButton(1).Tag = vbIgnore Case vbYesNoCancel ' = 3 ' .... Case vbYesNo ' = 4 ' .... Case vbRetryCancel ' = 5 ' .... Case Else ' Entspricht eigentlich vbOkOnly ' = 0 ' Wird aber auch für die eigentlich unzulässigen Werte 6 und 7 verwendet. ' .... End Select ' ' Hilfe - Schaltfläche hinzufügen? ' If Buttons And vbMsgBoxHelpButton Then cmdButton(mNoButtons).Caption = "&Hilfe" mNoButtons = mNoButtons + 1 End If ' ' benötigte Schaltflächen einblenden: ' For i = 0 To mNoButtons - 1 cmdButton(i).Visible = True Next ' ' Icon auswählen: ' Select Case Buttons And IconMask Case vbCritical imgIcon(0).Visible = True ' Enthält das Ausrufungszeichen Case vbQuestion imgIcon(1).Visible = True ' Enthält das Fragezeichen Case vbExclamation ' ... Case vbInformation ' ... End Select ' ' Focus auf den Default-Button: ' Me.Show ' der Focus kann nur bei sichtbarem Fenster verschoben werden. ' sobald der Focus gesetzt worden ist, wird das Fenster ' erst noch einmal geschlossen, damit es danach modal geöffnet werden kann. Select Case Buttons And DefaultButtonMask Case vbDefaultButton2 If mNoButtons >= 2 Then cmdButton(1).SetFocus mRetValue = cmdButton(1).Tag End If Case vbDefaultButton3 If mNoButtons >= 3 Then cmdButton(2).SetFocus mRetValue = cmdButton(2).Tag End If Case vbDefaultButton4 If mNoButtons >= 4 Then cmdButton(3).SetFocus mRetValue = cmdButton(3).Tag End If Case Else ' Auch hier der Standard zum Schluß - wie oben. cmdButton(0).SetFocus mRetValue = cmdButton(0).Tag End Select ' Fenster zunächst wieder verbergen Me.Hide End If ' ' Prompt und Titelzeile zuweisen: ' If Len(Prompt) Then lblPrompt.Caption = Prompt End If If Len(Title) Then Me.Caption = Title Else Me.Caption = App.Title End If ' ' HelpFile und -Context: ' If Len(HelpFile) Then mHelpFile = HelpFile If Not IsMissing(HelpContext) Then mHelpContext = HelpContext ' ' Dir überlasse die Größenanpassung und Positionierung ' der Steuerelemente: Schaltflächen, Icon, Meldungstext. ' ' Timer initialisieren: ' If Not IsMissing(TimeOut) Then timDefault.Interval = TimeOut timDefault.Enabled = True End If ' Nun die Form erneut sichtbar machen. jetzt aber modal. Me.Show vbModal ' hier geht es erst dann weiter, wenn die Form unsichtbar gemacht worden ist ShowMsg = mRetValue Unload MeEnd Function Private Sub cmdButton_Click(Index As Integer) If cmdButton(Index).Caption = "&Hilfe" Then Call WinHelp(Me.hwnd, mHelpFile, HELP_CONTEXT, mHelpContext) Else mRetValue = cmdButton(Index).Tag Me.Hide End IfEnd Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = vbFormControlMenu Then ' Schließen aus Systemmenü deaktivieren. Cancel = True End IfEnd Sub Private Sub timDefault_Timer() Me.HideEnd SubHinweise:Dieser Code ist unvollständig und nicht getestet - Du wirst Ihn noch bearbeiten müssen. Er zeigt aber, wie es gehen könnte.Die ganze Konstruktion ist so ausgelegt, daß, falls ein TimeOut - Wert angegeben wurde, ein Formular erscheint, daß genauso wie eine normale MsgBox funktioniert: Sie ist modal und gibt den Wert der Schaltfläche, die der Anwender betätigt hat, zurück.Wenn der Anwender in der Zeit, die durch TimeOut (in Millisekunden) festgelegt wurde, nicht reagiert, wird durch das Timer - Ereignis unsere Form wieder geschlossen. Der Ruckgabewert ist in diesem Fall die durch vbDefaultbutton1 bis 4 festgelegte Schaltfläche.Viel Erfolg!Thomas Prötzschcu
Thomas Prötzsch

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: