Ansicht erste Tabelle...
Joachim
Hallo Sepp,
super - das mit dem Sprung in Zelle E1 - Top Klappt..
Mit dem Code für die Arbeitsmappe, habe ich ein Problem.
Ich schicke die hier den gesamten Code für die Sektion ARBEITSMAPPE:
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 MappeSpeichern
If aw = vbNo Then ThisWorkbook.Saved = True
If aw = vbCancel Then Cancel = True
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
'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 an ...."
Else
'Programm lizensieren
Set_SerienNr_Blatt SerienNummer
Set_Datum_Blatt FormatDateTime(Date, vbShortDate)
Application.EnableEvents = False
ThisWorkbook.Save
Application.EnableEvents = True
ok = True
'Meldung = "Das Programm wurde soeben für Ihren Rechner lizensiert." & vbLf & _
"Viel Spaß!"
End If
Else
'schon lizensiert:
If SerienNr_Blatt <> SerienNummer Then
'falsche Festplatten-ID
Meldung = "Das Programm für auf einem anderen PC lizensiert." & vbLf & _
"Vielleicht haben Sie auch die Festplatte gewechselt." & vbLf & vbLf & _
"Bitte wenden Sie sich an ...."
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
--------------------------
Wo soll ich den zusätzlichen Code einbauen, da ja:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
schon vorhanden ist. Komme dann natürlich auf eine Fehlermeldung
Diese Arbeitsmappe ist als Excelobjekt definiert nicht als Modul.
Gruß
Joachim