AW: Menüpunkt in Excel deaktivieren..?
05.02.2006 15:21:08
Joachim
Hallo Hans,
perfekt deine Idee. (Du hast Recht -zu kompliziertes Denken- .....)
Da ich aber - wie du weisst (noch) nicht so viel Ahnung von Makros hab,
habe ich ein Problem die Anweisung einzubauen. Hier ist der Code für meine Abreitsmappe.
Kannst du mir die richtigen Positionen für die entsprechenden Anweisungen angeben?
---------------
Mein funktionierender Code:
_____________________________________
Option Explicit
Private Sub Workbook_Activate()
Application.OnKey "^{F12}", "AdminMode"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim aw
If Not ThisWorkbook.Saved Then
aw = MsgBox("Sollen ihre Änderungen in " & ThisWorkbook.Name & " gespeichert werden?", vbExclamation + vbYesNoCancel)
If aw = vbYes Then
Sheets("ANALYSE").Activate
MappeSpeichern
ElseIf aw = vbNo Then
Sheets("ANALYSE").Activate
ThisWorkbook.Saved = True
Else
Cancel = True
End If
Else
Sheets("ANALYSE").Activate
End If
End Sub
Private Sub Workbook_Deactivate()
Application.OnKey "^{F12}"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
If SaveAsUI Then
MsgBox "Datei kann nicht unter anderem Namen gespeichert werden!"
Exit Sub
End If
ThisWorkbook.Saved = MappeSpeichern
End Sub
Private Sub Workbook_Open()
Dim Sh As Worksheet
Dim ok As Boolean
Dim Meldung As String
ThisWorkbook.IsAddin = True
Sheets("ANALYSE").Activate
'Lizenz prüfen:
ok = False
If SerienNr_Blatt = "" Then
'noch nicht lizensiert:
If Datum_Blatt = "" Then Set_Datum_Blatt Date
If Date > CDate(Datum_Blatt) Then
'zu spät!
Meldung = "Die Lizensierungsmöglichkeit ist abgelaufen!" & vbLf & _
"Bitte wenden Sie sich ....."
Else
'Programm lizensieren
Set_SerienNr_Blatt SerienNummer
Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
Application.EnableEvents = False
ThisWorkbook.Save
Application.EnableEvents = True
ok = True
'Meldung = "Die tabelle wurde für Ihren Rechner lizensiert." & vbLf & _
"Viel Spaß!"
End If
Else
'schon lizensiert:
If SerienNr_Blatt <> SerienNummer Then
'falsche Festplatten-ID
Meldung = "Die Tabelle wurde für einen anderen PC lizensiert." & vbLf & _
"Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
"Bitte wenden Sie sich ....."
Else
ok = True
End If
End If
'If Not ok Then ActiveWindow.Visible = False
If Meldung <> "" Then
Application.EnableCancelKey = xlDisabled
MsgBox Meldung
Application.EnableCancelKey = xlInterrupt
End If
ThisWorkbook.IsAddin = False
If Not ok Then
ThisWorkbook.Close False
Exit Sub
End If
'Alle Blätter einblenden
For Each Sh In Worksheets
If Sh.Name <> MakroBlatt Then
Sh.Visible = True
End If
Next Sh
'Infoblatt ausblenden
Sheets(MakroBlatt).Visible = xlSheetVeryHidden
ThisWorkbook.Saved = True
End Sub
___________________________________________
Einzutragen wäre ja:
Sub Menue_aktivieren() 'Menü Einfügen einschalten
Dim Datei
For Each Datei In Application.CommandBars.FindControls(ID:=30005)
Datei.Enabled = True
Next
End Sub
Sub Menue_deaktivieren() 'Menü Einfügen ausschalten
Dim Datei
For Each Datei In Application.CommandBars.FindControls(ID:=30005)
Datei.Enabled = False
Next
End Sub
Mit den Anweisungen Workbook Open bzw. Workbook before Close habe ich meine Prob.
da ich immer wieder auf Fehler laufe.
Gruß
Joachim