Bin mit meinem 'Latein' am Ende und hoffe, Ihr könnt mir ne Code-Zeile schenken, für die ich einfach zu blöd bin. Habe folgenden Code aus vielen, u. A. von Hajo zusammengebaut.
Folgendes:
Der Anwender darf die Befehle STRG-C, -V und -X nicht nutzen und darf die zu bearbeitende Mappe nur unter .xlsm speichern. Da er dafür die Makros aktivieren muss, sieht er, falls er das nicht macht, nur ein Blatt, das "Makros_deaktiviert" heißt, in dem zu lesen steht, er habe die Makros zu aktivieren.
Macht er das, wird beim Öffnen der Mappe dieses Hinweis-Blatt aus- und die zu bearbeitenden Blätter eingeblendet.
Das funktioniert auch so weit ganz gut. Nur, wenn er SPEICHERN UNTER wählt und die Mappe unter einem anderen Namen abspeichert UND DANACH auf SCHLIESSEN geht UND den dann aufpoppenden Dialog "Wollen Sie speichern?" mit NEIN abbricht, läuft was falsch:
Öffnet er die (neue) gespeichert-unter-Mappe mit deaktivierten Makros, sind die Blätter alle geöffnet anstatt ausschließlich das Blatt "Makros_deaktiviert".
Welchen Code-Teil muss ich ändern bzw. hinzufügen? Danke schon mal!!
Gruß,
Jens
Dim InI As Integer ' Zählvariable für Register
Dim BoSichern As Boolean ' Variable für Speicherung
Private Sub Workbook_Open()
ActiveWorkbook.Unprotect ("ib_jm")
Application.ScreenUpdating = False ' aktualisierung Bildschirm aus
For InI = Sheets.Count To 1 Step -1 ' alle Tabellen einblenden
vom letzten bis zum ersten
Sheets(InI).Visible = True
Next InI
Sheets("Makros_deaktiviert").Visible = False ' Tabelle mit Hinweis ausblenden
' Schalter Veränderung der Datei zurückstellen
' Damit das einblenden der Register nicht als Veränderung
' der Datei angesehen wird
Sheets("VOREINSTELLUNGEN").Activate
ActiveWorkbook.Saved = True
Application.ScreenUpdating = True ' aktualisierung Bildschirm ein
ActiveWorkbook.Protect ("ib_jm")
'Die Befehle STRG-C, STRG-V und STRG-X werden deaktiviert:
Application.OnKey "^{c}", ""
Application.OnKey "^{v}", ""
Application.OnKey "^{x}", ""
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Dieses Ereignis wird auch angesprungen falls in
' Workbook_BeforeClose die Speicherabfrage mit Ja beantwortet wird
' Das speichern muß abgefangen werden damit die Datei nicht
' mit eingeblendeten Tabellen gespeichert wird.
ActiveWorkbook.Unprotect ("ib_jm")
If BoSichern = False Then
Cancel = True ' das Sicherungsereignis abbrechen, keine Speicherung
' Hinweis
MsgBox "Diese Arbeitsmappe kann nur beim SCHLIESSEN gespeichert werden!" & vbLf & vbLf & _
_
"Zwischenspeicherungen über den Dialog SPEICHERN UNTER ausführen. Hierbei wird _
die aktuelle Datei überschrieben, wenn Sie den Namen der Mappe nicht ändern." & vbLf & vbLf & _
"Über den Dialog SPEICHERN UNTER können Sie die Mappe auch unter einem anderen _
Namen speichern."
Else
' eine Tabelle muß mindestens eingeblendet sein
Sheets("Makros_deaktiviert").Visible = True
' alle Tabellen ausblenden vom letzten bis zum ersten
' außer "Makros_deaktiviert"
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name "Makros_deaktiviert" Then _
Sheets(InI).Visible = xlVeryHidden
Next InI
End If
ActiveWorkbook.Protect ("ib_jm")
'Die Arbeitsmappe darf nur im Format XLSM abgespeichert werden:
Dim varWorkbookName As String
Dim xbCModus As Integer
Application.EnableEvents = False
If SaveAsUI = True Then
varWorkbookName = Application.GetSaveAsFilename( _
fileFilter:="Excel IB Arbeitszeiterfassung (*.xlsm), *.xlsm")
Cancel = True
If varWorkbookName "Falsch" Then
If Application.Version > 11 Then
If Right(varWorkbookName, 4) = "xlsm" Then vartyp = _
xlOpenXMLWorkbookMacroEnabled Else vartyp = xlOpenXMLTemplateMacroEnabled ' _
52,53
ActiveWorkbook.SaveAs Filename:=varWorkbookName, FileFormat:=vartyp
Else 'save fuer altes office
End If
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' ausblenden aller Register außer Sheets("Makros_deaktiviert")
' mit xlVeryHidden
' dies hat den Vorteil, sie können nur per VBA eingeblendet werden.
BoSichern = True ' Datei schliessen wurde ausgelöst
ActiveWorkbook.Unprotect ("ib_jm") ' falls Dateischutz
If ActiveWorkbook.Saved Then ' Prüfen ob Datei verändert
' Datei wurde nicht verändert
' eine Tabelle muß mindestens eingeblendet sein
Sheets("Makros_deaktiviert").Visible = True
' alle Tabellen ausblenden vom letzten bis zum ersten
' außer "Makros_deaktiviert"
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name "Makros_deaktiviert" Then _
Sheets(InI).Visible = xlVeryHidden
Next InI
BoSichern = True
ThisWorkbook.Save
End If
ActiveWorkbook.Protect ("ib_jm") ' Dateischutz wieder setzen
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=True 'Diese Zeile bringt nichts :-(
'Standardfunktion wieder aktivieren nach dem Schließen der Mappe
Application.OnKey "^{c}"
Application.OnKey "^{v}"
Application.OnKey "^{x}"
End Sub
'Das Kontextmenü in dieser Arbeitsmappe wird deaktiviert (um z. B. Kopieren und Einfügen zu verhindern:)
'
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As _
Boolean)
Cancel = True
End Sub