title image


Smiley Re: Menüleiste mit Controlpopups: wie Controlbutton hinzufügen?
Hallo Maddin,



1. Und das traust du dir auch noch zu schreiben.



2. In jede Routine gehört eine Fehlerroutine!!! Und wenn sie gut gemacht ist, noch mit der Anzeige, in welcher Zeile der Fehler passiert ist. Mit "On Error Resume Next" läufst du bei jedem Fehler weiter und bekommst sie gar nicht mit.



3.1. Du sollst die Leiste nicht löschen oder neu anlegen beim wechseln von einer Mappe in die andere, sondern nur die Enabled - Eigenschaft setzen. Daher auch die Konstante für den Namen der Leiste, weil er mehrfach verwendet wird. Die Routine gehört dann in ein Standardmodul und die Eigenschaft wird über einen Parameter gesteuert.



3.2. Wenn du im BeforeClose - Ereignis die Leiste ohne Nachfrage löschst und beim schließen der Mappe die Nachfrage ob gespeichert werden soll abbrichst, wird die Leiste gelöscht, obwohl die Mappe nicht geschlossen wurde.



Wenn ich das ganze für eine Firma schreiben sollte, dann würde das bei mir ungefähr so aussehen. Wobei der User eigentlich eine andere Meldung angezeigt bekommt, und die echten Fehlermeldungen in ein Logfile eingetragen werden, welches ich automatisch einmal pro Woche geschickt bekomme.



' **********************************************************************' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)' **********************************************************************Option ExplicitPrivate Sub Workbook_Activate()    1 Const PROCEDURNAME = "Workbook_Activate"    2 On Error GoTo err_exit    3 Call prcShowMenu(True)    4 Exit Sub    5 err_exit:    6 MsgBox "Fehler " & CStr(Err.Number) & " in Zeile " & CStr(Erl) _        & vbLf & vbLf & Err.Description & vbLf & vbLf & "Makro " & _        PROCEDURNAME, vbCritical, "Fehlermeldung"End SubPrivate Sub Workbook_BeforeClose(Cancel As Boolean)1 Const PROCEDURNAME = "Workbook_BeforeClose"2 On Error GoTo err_exit3 With ThisWorkbook4 If Not .Saved And Not .ReadOnly Then    5 Select Case MsgBox("Änderungen in ''" & .Name & _        "'' speichern?", vbQuestion + vbYesNoCancel, "Abfrage")Case vbYes    6 .Save    7 Case vbNo    8 .Saved = True    9 Case vbCancel    10 Cancel = True    11 Exit Sub    12 End Select    13 End If    14 Call prcDeleteteMenu    15 End With    16 Exit Sub    17 err_exit:    18 MsgBox "Fehler " & CStr(Err.Number) & " in Zeile " & CStr(Erl) _        & vbLf & vbLf & Err.Description & vbLf & vbLf & "Makro " & _        PROCEDURNAME, vbCritical, "Fehlermeldung"    19 Call prcDeleteteMenuEnd SubPrivate Sub Workbook_Deactivate()    1 Const PROCEDURNAME = "Workbook_Deactivate"    2 Call prcShowMenu(False)    3 Exit Sub    4 err_exit:    5 MsgBox "Fehler " & CStr(Err.Number) & " in Zeile " & CStr(Erl) _        & vbLf & vbLf & Err.Description & vbLf & vbLf & "Makro " & _        PROCEDURNAME, vbCritical, "Fehlermeldung"End SubPrivate Sub Workbook_Open()    1 Const PROCEDURNAME = "Workbook_Open"    2 Call prcCreateMenu    3 Exit Sub    4 err_exit:    5 MsgBox "Fehler " & CStr(Err.Number) & " in Zeile " & CStr(Erl) _        & vbLf & vbLf & Err.Description & vbLf & vbLf & "Makro " & _        PROCEDURNAME, vbCritical, "Fehlermeldung"End Sub' **********************************************************************' Modul: Modul1 Typ: Allgemeines Modul' **********************************************************************Option ExplicitOption Private ModulePrivate Const TBL_MENUNAME = "Mainmenu"Public Sub prcCreateMenu()    1 Const PROCEDURNAME = "prcCreateMenu"    2 Dim tlbNewMenu As CommandBar    3 Dim tlbPopup1 As CommandBarPopup, tlbPopup2 As CommandBarPopup    4 Dim tlbButton As CommandBarButton    5 On Error GoTo err_exit    6 Call prcDeleteteMenu    7 Set tlbNewMenu = CommandBars.Add(Name:=TBL_MENUNAME, _        Position:=msoBarTop, Temporary:=True)    8 Set tlbPopup1 = tlbNewMenu.Controls.Add(Type:=msoControlPopup)    9 tlbPopup1.Caption = " Numero Uno "    10 Set tlbButton = tlbPopup1.Controls.Add(Type:=msoControlButton)    11 With tlbButton    12 .Caption = " Alpha "    13 .FaceId = 18    14 .Style = msoButtonIconAndCaption    15 .OnAction = "Alpha"    16 End With    17 Set tlbButton = tlbPopup1.Controls.Add(Type:=msoControlButton)    18 With tlbButton    19 .Caption = " Bravo "    20 .FaceId = 23    21 .Style = msoButtonIconAndCaption    22 .OnAction = "Bravo"    23 End With    24 Set tlbPopup2 = tlbPopup1.Controls.Add(Type:=msoControlPopup)    25 tlbPopup2.Caption = " Charlie"    26 Set tlbButton = tlbPopup2.Controls.Add(Type:=msoControlButton)    27 With tlbButton    28 .Caption = " Test1 "    29 .FaceId = 80    30 .Style = msoButtonIconAndCaption    31 .OnAction = "Test1"    32 End With    33 Set tlbButton = tlbPopup2.Controls.Add(Type:=msoControlButton)    34 With tlbButton    35 .Caption = " Test2 "    36 .FaceId = 81    37 .Style = msoButtonIconAndCaption    38 .OnAction = "Test2"    39 End With    40 Set tlbButton = tlbPopup2.Controls.Add(Type:=msoControlButton)    41 With tlbButton    42 .Caption = " Test3 "    43 .FaceId = 82    44 .Style = msoButtonIconAndCaption    45 .OnAction = "Test3"    46 End With    47 Exit Sub    48 err_exit:    49 MsgBox "Fehler " & CStr(Err.Number) & " in Zeile " & CStr(Erl) _        & vbLf & vbLf & Err.Description & vbLf & vbLf & "Makro " & _        PROCEDURNAME, vbCritical, "Fehlermeldung"    50 Call prcDeleteteMenuEnd SubPublic Sub prcDeleteteMenu()1 Const PROCEDURNAME = "prcDeleteteMenu"2 On Error GoTo err_exit3 Do4 Application.CommandBars(TBL_MENUNAME).Delete5 Loop While Err.Number = 06 err_exit:7 If Err.Number = 5 Then    8 Exit Sub    9 Else    10 MsgBox "Fehler " & CStr(Err.Number) & " in Zeile " & CStr(Erl) _        & vbLf & vbLf & Err.Description & vbLf & vbLf & "Makro " & _        PROCEDURNAME, vbCritical, "Fehlermeldung"    11 End IfEnd SubPublic Sub prcShowMenu(ByRef blnEnabled As Boolean)1 Const PROCEDURNAME = "prcShowMenu"2 On Error GoTo err_exit3 prcstart:4 Application.CommandBars(TBL_MENUNAME).Enabled = blnEnabled5 Exit Sub6 err_exit:7 If Err.Number = 5 Then    8 Call prcCreateMenu    9 Resume prcstart    10 Else    11 MsgBox "Fehler " & CStr(Err.Number) & " in Zeile " & CStr(Erl) _        & vbLf & vbLf & Err.Description & vbLf & vbLf & "Makro " & _        PROCEDURNAME, vbCritical, "Fehlermeldung"    12 End IfEnd Sub

Ich weiß, die Einrückung des Code sieht beschissen aus, aber das liegt an der Jeanie, die kann leider mit Zeilennummern nicht umgehen.
Gruß
Nepumuk


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: