Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Schleifen mit Ausblenden und Speichern

Betrifft: Schleifen mit Ausblenden und Speichern von: Jens
Geschrieben am: 27.10.2014 15:43:05

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

  

Betrifft: AW: Schleifen mit Ausblenden und Speichern von: Jens
Geschrieben am: 28.10.2014 11:52:13

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



 

Beiträge aus den Excel-Beispielen zum Thema "Schleifen mit Ausblenden und Speichern"