Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1388to1392
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Schleifen mit Ausblenden und Speichern

Schleifen mit Ausblenden und Speichern
27.10.2014 15:43:05
Jens
Hallo, liebe Excelgemeinde!
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleifen mit Ausblenden und Speichern
28.10.2014 11:52:13
Jens
Weniger ist mehr. Ich habe den Code vereinfacht. So funktioniert es:
Der Anwender kann sogar über den normalen Befehl SPEICHERN zwischenspeichern. Speichern unter funktioniert auch. Nur beim Schließen wird zwangsmäßig gespeichert, da die Blätter ausgeblendet werden müssen.
Private Sub Workbook_Open()
Dim sh As Object
ActiveWorkbook.Unprotect ("ib_jm")
Application.ScreenUpdating = False              ' Aktualisierung Bildschirm aus
For Each sh In Sheets
sh.Visible = xlSheetVisible
Next
Sheets("Makros_deaktiviert").Visible = xlSheetVeryHidden
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)
'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
End If
End If
End If
Application.EnableEvents = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Standardfunktion wieder aktivieren nach dem Schließen der Mappe
Application.OnKey "^{c}"
Application.OnKey "^{v}"
Application.OnKey "^{x}"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Unprotect ("ib_jm")
Sheets("Makros_deaktiviert").Visible = xlSheetVisible
For Each sh In Sheets
If sh.Name  "Makros_deaktiviert" Then sh.Visible = xlSheetVeryHidden
Next
Worksheets("VOREINSTELLUNGEN").Activate
If ActiveWorkbook.Saved = False Then ActiveWorkbook.Save
ActiveWorkbook.Protect ("ib_jm")
Application.DisplayAlerts = True
Application.ScreenUpdating = True
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige