properties of tab greyed out when closing

[fnijkampnl]

Hi,
I didn't do a search for this problem because I do not know how to make a correct search argument.
That is all answers were about something else.

This is the case.
In my BeforeClose procedure I did a VeryHidden on all tabs and a show on a tab with a warning.
The warning stated that the macro protection should be off.
In the Open procedure I did the reverse action.

This went fine. Until I made a change of some kind, I don't know what.

Know when I close, and break at the 1st statement in the BeforeClose proc, I see that all is greyed out on the properties of each tab.
No matter if it is protected or not.

What could cause this?

 

[Skyybot]

Can you submit your Code?

 

[fnijkampnl]

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i#
    
    If Not bAltF4 Then
        Cancel = True
        'MsgBox "Sluit het Rooster met de toetsen [ALT]+[F4]", vbInformation
        SendKeys "%{F8}CloseFile{Enter}", False
        Exit Sub
    End If
    
    bAltF4 = False
    bClose = True

    If Sheets(shOfferte).Visible = xlSheetVeryHidden Then
        GoTo L900
    End If

    Sheets(shRooster).Select
'    CommentaarToolTipGrootte
    GoTo L900

L900:
    
    Screen "On", 37
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim r%, rl%, sPath$, sFilename$, aDir() As String, sMsg$, i#
    
    If ActiveSheet.Name = shFactuur Then
        Cancel = True

        If Cells(13, 4) = "" Then
            MsgBox "Factuurnummer niet ingevuld", vbCritical, "PRINT FACTUUR"
            Exit Sub
        End If
    End If
    
    Screen "Off", 38, True
    iEventNr = Cells(1, 3)
    
    With Sheets(shRooster)
        r = 2
        
        Do
            r = r + 1
            If .Cells(r, kStatus) = txNr Then
                MsgBox "Evenement " & iEventNr & " niet gevonden", vbCritical, "FOUT"
                Cancel = True
                Exit Do
            End If
            
            If .Cells(r, kEVT) = iEventNr Then
                If ActiveSheet.Name = shFactuur Then
                    If InStr(1, .Cells(r, kStatus), ".7", vbTextCompare) = 0 _
                    And InStr(1, .Cells(r, kStatus), ".8", vbTextCompare) = 0 _
                    And InStr(1, .Cells(r, kStatus), ".9", vbTextCompare) = 0 Then
                        MsgBox "Factuur is nog niet gecontroleerd", vbCritical, "FOUT"
                        Exit Do
                    End If
                    
                    .Cells(r, kStatus) = Replace(.Cells(r, kStatus), ".7", ".8", 1, , vbTextCompare)
                    condFormat
                    EVTNaam = .Cells(r, kEVT - 3)
                    EVTDatum = .Cells(r, kEVT - 2)
                    EVTLog = txFactuurGeprint & " met nr " & Cells(13, 4)
                    AddLog ""
                    EVTLog = "kolom 4 gevuld met " & .Cells(r, kStatus) & " door " & .Cells(rInUse, kInUseDoor)
                    AddLog ""
    
                    If txMessage <> "" Then
                         If MsgBox(txMessage & Chr(10) & "Toch afdrukken?", vbYesNo, "Factuur") <> vbYes Then
                            Exit Do
                         End If
                    End If
                End If
                
                Exit Do
            End If
        Loop
    End With
    
    If ActiveSheet.Name = shFactuur Then
        sPath = ActiveWorkbook.Path & "\gegenereerde facturen\"
        
        If InStr(1, sPath, "_Rooster\gegenereerde facturen\", vbTextCompare) = 0 Then
            MsgBox "Sluit dit bestand en open het vanuit de map _Rooster", vbCritical, _
                   "AFDRUK GAAT FOUT"
            ActiveWorkbook.Close
            Exit Sub
        End If
        
        sFilename = "Factuur " & _
                                 Cells(13, 4) & "-" & Cells(15, 4) & ".pdf"
        ActiveWorkbook.ActiveSheet.ExportAsFixedFormat xlTypePDF, sPath & sFilename
                  
        If Year(Now()) <> Cells(1, 1) Then
            Cells(1, 1) = Year(Now())
            Cells(1, 2) = 0
        End If
        
        Cells(1, 2) = Cells(1, 2) + 1
        Cells(13, 4) = Format(Cells(1, 1), "0000") & "-" & Format(Cells(1, 2), "0000")
        Erase aDir
        aDir = Split(sPath, "\", , vbTextCompare)
        
        sMsg = "Het PDF bestand van de factuur is te vinden in de map:" & Chr(10)
              
        For i = 0 To UBound(aDir)
            sMsg = sMsg & Application.WorksheetFunction.Rept("  ", i) & aDir(i) & Chr(10)
        Next i
        
        sMsg = sMsg & Chr(10) & _
               "met de naam " & Chr(10) & Chr(10) & sFilename & Chr(10) & Chr(10) & _
               "Verplaats het bestand naar de map van het evevenement"
        
        MsgBox sMsg, vbInformation, "FACTUUR AANGEMAAKT"
        Cells(13, 4) = ""
    End If
    
    Screen "On", 38, True

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sSheet As String
    If SaveAsUI Then
        MsgBox "Sorrie, maar Bewaren als, is niet toegestaan", vbCritical, "No Save As"
        Cancel = True
        Exit Sub
    End If
    
    Screen "Off", 30
    sSheet = ActiveSheet.Name
    
    If ThisWorkbook.Name <> sBESTANDSNAAM Then
        If MsgBox("Dit Rooster heeft niet de juiste naam voor het Rooster" & Chr(10) & Chr(10) & _
                    "Aanpassingen in dit bestand zullen geen invloed hebben op het origineel" & Chr(10) & _
                    "Het origineel heeft de naam " & sBESTANDSNAAM & Chr(10) & Chr(10) & _
                    "Wil je doorgaan?", vbYesNo, "EVENEMENTEN") = vbNo Then
            Screenon
            ActiveWorkbook.Close SaveChanges:=False
            ActiveWorkbook.Save
        End If
    Else
        SetVersie
    End If
    
    Sheets(shRooster).Select
    Sheets(shRooster).Cells(2, 3) = "Bewaard: " & Now()
    EVTNaam = "Save bestand"
    EVTDatum = "nu"
    EVTLog = "Save bestand"
    AddLog ""
    
    If bClose Then
        If MsgBox("Wil je het bestand vrijgeven?", vbYesNo) = vbYes Then
            EVTNaam = "Sluit bestand"
            EVTDatum = "nu"
            EVTLog = "Sluit bestand met vrijgave"
            AddLog ""
            Sheets(shRooster).Cells(rInUse, kInUseDoor) = ""
            Sheets(shRooster).Cells(rInUse, kSindsTS) = ""
        Else
            EVTNaam = "Sluit bestand"
            EVTDatum = "nu"
            EVTLog = "Sluit bestand met vrijgave"
            EVTLog = "Sluit bestand zonder vrijgave"
        End If
        
        delete_validation
        VerbergSheets
    Else
        Sheets(sSheet).Select
    End If
    
    Screen "On", 30
    
End Sub

Private Sub Workbook_Open()
    Screen "Off", 28
    Application.OnKey "%{f4}", "CloseFile"
    
    CheckVersie
    
    ShowSheets
    
    bAltF4 = False
    bClose = False
    ActiveWorkbook.RefreshAll
    Sheets(shRooster).Select
    Reset_Show
    GeleArcering
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    
    If Not ThisWorkbook.ReadOnly Then
        If Sheets(shRooster).Cells(rInUse, kInUseDoor) <> "" Then
            If Sheets(shRooster).Cells(rInUse, kInUseDoor) <> Application.UserName Then
                If MsgBox("Het bestand wordt aangepast door " & Sheets(shRooster).Cells(rInUse, kInUseDoor) & " sinds " & Sheets(shRooster).Cells(rInUse, kSindsTS) & Chr(10) & _
                           "Wil je doorgaan?", vbYesNo) = vbNo Then
                    ActiveWorkbook.Close SaveChanges:=False
                    ActiveWorkbook.Save
                Else
                    ThisWorkbook.ChangeFileAccess mode:=xlReadOnly
                End If
            End If
        Else
            Sheets(shRooster).Cells(rInUse, kInUseDoor) = Application.UserName
            Sheets(shRooster).Cells(rInUse, kSindsTS) = Now()
            
On Error Resume Next
            ActiveWorkbook.Save
On Error GoTo 0
            Sheets(shRooster).Cells(rInUse, kSindsTS) = Now()
            EVTNaam = "Open bestand"
            EVTDatum = "nu"
            EVTLog = "Open bestand"
            AddLog ""
        End If
    End If
    
    If ThisWorkbook.Name <> sBESTANDSNAAM Then
        If MsgBox("Dit Rooster heeft niet de juiste naam voor het Rooster" & Chr(10) & Chr(10) & _
                    "Aanpassingen in dit bestand zullen geen invloed hebben op het origineel" & Chr(10) & _
                    "Het origineel heeft de naam " & sBESTANDSNAAM & Chr(10) & Chr(10) & _
                    "Wil je doorgaan?", vbYesNo, "EVENEMENTEN") = vbNo Then
            Screenon
            ActiveWorkbook.Close SaveChanges:=False
            ActiveWorkbook.Save
        End If
    End If
    
    condFormat
    Tel_Activiteit 9999
    Screen "On", 28
    
    Positie
End Sub
=============================================================================================================
Sub Screen(mode As String, nr As Long, Optional bProtect As Boolean)
    If nr > 44 Then nr = nr / 0
    
    If mode = strOn Then
        If nr = nrScreenOff _
        Or nrScreenOff = 0 Then
            nrScreenOff = 0
            If bProtect Then ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            Screenon
        End If
    Else
'        MsgBox "nr=" & nr, vbOKOnly
        If nrScreenOff = 0 Then
            nrScreenOff = nr
        End If
        
        If bProtect Then ActiveSheet.Unprotect Password:="rBFvGy4S"
        Screenoff
    End If
End Sub
Sub Screenoff()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Sub Screenon()
On Error Resume Next
    nrScreenOff = 0
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Calculate
    Application.EnableEvents = True
On Error GoTo 0
End Sub

 

[fnijkampnl]

Sub CloseFile()
    bClose = True
    bAltF4 = True
    Workbooks.Application.ActiveWorkbook.Save
    Workbooks.Application.ActiveWorkbook.Close False
End Sub

Sub delete_validation()
Dim iWS#, bError As Boolean, iMrij#, iMkol#, bMerge As Boolean, i#
Dim rng As Range, vRng As Range, cl As Range
On Error GoTo lError

    iWS = ActiveWorkbook.Worksheets.Count
    
    For i = 1 To iWS
        bError = False
        Sheets(i).Select
        
        If bError Then GoTo lNexti
        
        Sheets(i).Unprotect Password:="rBFvGy4S"
        Set rng = Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell))
        Set vRng = rng.SpecialCells(xlCellTypeAllValidation)
        
        If bError Then GoTo lNexti
        
        If rng.Rows.Count = vRng.Rows.Count Then GoTo lNexti
        
        If Not bError Then
            iMkol = 0
            iMrij = 0
            
            For Each cl In vRng
                bMerge = False
                
                If cl.MergeCells Then
                    If iMrij = cl.Row _
                    And iMkol + 1 = cl.Column Then
                        ' skip want is next in merge
                        bMerge = True
                    Else
                        iMrij = cl.Row
                    End If
                    
                    iMkol = cl.Column
                End If
                    
                If Not bMerge Then
                    If cl.Validation.Type = xlValidateList Then
                        cl.Validation.Delete
                    Else
                        If MsgBox("afwijkende validatie gevonden" & Chr(10) & _
                                "validatietype    :" & cl.Validation.Type & Chr(10) & _
                                "op sheet         :" & i & _
                                "wil je stoppen?", vbYesNo) = vbYes Then
                            i = i / 0
                        End If
                    End If
                End If
lNextcl:
            Next cl
        End If
lNexti:
    Next i
    
    GoTo L999
lError:
    If Err.Number = 1004 Then
        bError = True
        Resume Next
    End If
    
    MsgBox Err.Number & Chr(10) & _
           Err.Description & Chr(10), vbCritical
    rPost = rPost / 0
L999:

End Sub

Sub VerbergSheets()
Dim ws As Worksheet, aAnt$

    Screen "Off", 34
 '   Protect_Sheets
    
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = shWaarschuwing Then
            Sheets(ws.Name).Visible = xlSheetVisible
        Else
            Sheets(ws.Name).Visible = xlSheetVeryHidden
        End If
    Next ws
 
    Screen "On", 34
    aAnt = vbNo
    
    While aAnt = vbNo
        aAnt = MsgBox("Let op: Sluit de computer pas af" & Chr(10) & _
                    "als Gdrive gesynchroniseerd heeft!" & Chr(10) & Chr(10) & _
                    "Klik op de gekleurde driehoek rechtsonder op de taakbalk" & Chr(10) & _
                    "en controleer of de sheet is ge-upload" & Chr(10) & _
                    "Pas dan kun je de computer afsluiten.", vbOK, "SYNCHRONISATIE")
    Wend
    
End Sub
Sub ShowSheets()
Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Worksheets
        Select Case ws.Name
        Case shKadoSamenvoeg
            Sheets(ws.Name).Visible = xlSheetHidden
        Case "AFDRUK NIET AANPASSEN"
            Sheets(ws.Name).Visible = xlSheetHidden
        Case shAanstelling
            Sheets(ws.Name).Visible = xlSheetHidden
        Case Else
            Sheets(ws.Name).Visible = xlSheetVisible
        End Select
    Next ws
    
    Sheets(shWaarschuwing).Visible = xlSheetVeryHidden
End Sub

Sub Reset_Show()
    Reset_Show_X
    If rSave > 0 Then
        Cells(rSave, 2).Select
        rSave = 0
        show_vkr True
    End If
    
    Positie
End Sub
Sub Reset_Show_X()
Dim r, k As Integer

    Screen "Off", 4
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    Show_Shapes True
    
    r = ActiveCell.Row
    k = ActiveCell.Column
    Cells(1, 2) = ""
    Cells.Select
    Selection.EntireRow.Hidden = False
    Selection.EntireColumn.Hidden = False
    Screen "On", 4
End Sub

Sub GeleArcering()
    Screen "Off", 19
    Sheets(shRooster).Select

    swArc = True
    
'bepaal nummerrij
    rEvtNr = 2
    Do
        rEvtNr = rEvtNr + 1
        If Cells(rEvtNr, kEVT - 1) = "Datum" Then
            MsgBox txEvtNotFound, vbCritical, txFoutOntdekt
            End
        End If
        If Cells(rEvtNr, kEVT - 1) = txNr Then Exit Do
    Loop
'bepaal laatse VKR rij
    rVKRmax = rEvtNr + 8
    Do
        rVKRmax = rVKRmax + 1
        If Cells(rVKRmax, kEVT - 2) = "" Then
            rVKRmax = rVKRmax - 1
            Exit Do
        End If
    Loop
        
    rEVT = 2
    Do
        rEVT = rEVT + 1
        If Cells(rEVT, kEVT) = "" Then Exit Do
        If rEVT = rEvtNr Then Exit Do
        swArc = Not swArc
        kDienst = kEVT
        
        Do
            kDienst = kDienst + 1
            If Cells(rEvtNr, kDienst) = "" Then Exit Do

            If Cells(rEvtNr, kDienst) = Cells(rEVT, kEVT) Then
'status te laat?
                Cells(rEVT, kEVT - 2).Select
                
                If InStr(1, Cells(rEVT, kEVT - 1), ".5", 1) _
                Or InStr(1, Cells(rEVT, kEVT - 1), ".6", 1) _
                Or Cells(rEVT, kEVT - 1) = "" _
                Or Cells(rEvtNr + 1, kDienst) > Now() + 21 _
                Or Cells(rEvtNr + 1, kDienst) <= Now() Then
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColor = 14277081
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = -0.149998474074526
                        .PatternTintAndShade = 0
                    End With
                Else
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColor = 14277081
                        .Color = 10066431
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    
                End If
'horizontaal
                Range(Cells(rEVT, kEVT + 1), Cells(rEVT, kDienst)).Select
                If swArc Then
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColor = 16777215
                        .Color = 13434879
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                Else
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColor = 16777215
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                End If
'verticaal
                Range(Cells(rEVT, kDienst), Cells(rEvtNr - 1, kDienst)).Select
                If swArc Then
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColor = 16777215
                        .Color = 13434879
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                Else
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColor = 16777215
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                End If
                
                Range(Cells(rEvtNr + 9, kDienst), Cells(rVKRmax, kDienst)).Select
                If swArc Then
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColor = 16777215
                        .Color = 13434879
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                Else
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColor = 16777215
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                End If
            End If
        Loop
    Loop
    
    If rEvtNr > 10 Then
        Application.GoTo Reference:=Worksheets(shRooster).Cells(rEvtNr - 10, 6), _
            Scroll:=True
    End If
        
    Screen "On", 19
End Sub

 

[fnijkampnl]

Sorry the code is not optimal, I don't expect anyone else is going to work with