• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Blad Beveiligen

Status
Niet open voor verdere reacties.
Knop 1 om sheet1 te beveiligen en de beveiliging van sheet 1 af te halen met een wachtwoord.

En een 2e knop om alle bladen zichtbaar/onzichtbaar te maken behalve sheet1 en 2 deze moeten zichtbaar blijven voor iedereen, en deze knop moet een ander wachtwoord hebben dan knop 1
 
Zoiets dus:
 

Bijlagen

Bedankt voor je reactie en bestand, ziet er goed uit.

Alleen moet knop 2 ook de bladen 3 t/m 6 verbergen, en bij vrijgeven weer laten zien.
 
Simpele aanpassing natuurlijk:
 

Bijlagen

Super bedankt voor deze oplossing, is het wellicht ook nog mogelijk dat als knop actief is deze rood kleurt en anders groen?

En ik zou graag nog een msgbox hebben als het wachtwoord fout is, en bij fout wachtwoord moet knop actief blijven (rood)
 
Je zou dat toch zo langzamerhand met alle eerdere voorbeelden zelf moeten kunnen doen.
 
Ben er al even mee aan het klooien ondertussen deze ochtend maar krijg het niet voor elkaar helaas:o:o

Code: 
Private Sub CommandButton1_Click()

    ww = "WWSHT1"
    If CommandButton1.Caption = "Beveilig Sheet1" Then
        Sheets("Sheet1").Protect ww
        CommandButton1.Caption = "Vrijgeven Sheet1"
        CommandButton1.BackColor = RGB(255, 0, 0)
    Else
    CommandButton1.BackColor = RGB(146, 208, 80)
        If InputBox("Wachtwoord: ") <> ww Then Exit Sub
        Sheets("Sheet1").Unprotect ww
        CommandButton1.Caption = "Beveilig Sheet1"
    End If
End Sub

Code: 
Private Sub CommandButton1_Click()
    ww = "Aftersales"
    If CommandButton1.Caption = "Beveilig Sheet1" Then
        Sheets("Sheet1").Protect ww
        CommandButton1.Caption = "Vrijgeven Sheet1"
        CommandButton1.BackColor = RGB(255, 0, 0)
    Else
    ww = InputBox("Voer wachtwoord in:")
    If ww = Aftersales Then
    Sheets("Sheet1").Unprotect ww
    CommandButton1.BackColor = RGB(146, 208, 80)
Else
    MsgBox "onjuist wachtwoord"
    CommandButton1.BackColor = RGB(255, 0, 0)
    Exit Sub
    End If
End If
End Sub
 
Laatst bewerkt:
Kijk eens naar deze:
 

Bijlagen

Goedemorgen,

Ik heb jou prachtig gemaakte oplossing geplaatst in het document waar het uiteindelijk in moest komen, maar nu krijg ik onderstaande fout?

" compile error expected function or variable "

Enig idee wat er fout kan zijn?

Code: 
Private Sub CommandButton1_Click()
    ww = "Demo2023"
    If CommandButton1.Caption = "Beveilig -OVERZICHT-" Then
        Sheets("-OVERZICHT-").Protect ww
        CommandButton1.Caption = "Vrijgeven -OVERZICHT-"
        CommandButton1.BackColor = RGB(227, 74, 70)
    Else
        If InputBox("Wachtwoord: ") <> ww Then
            MsgBox "Onjuist wachtwoord", vbCritical, "Fout"
        Else
            Sheets("-OVERZICHT-").Unprotect ww
            CommandButton1.Caption = "Beveilig -OVERZICHT-"
            CommandButton1.BackColor = RGB(106, 177, 135)
        End If
    End If
End Sub
 
Doet het hier prima.
Er zal dus een andere oorzaak zijn.
Plaats dat document eens hier.
 
Bestand is te groot om hier te plaatsen, ik heb het bestand kleiner gemaakt en het vreemde is dan werkt het allemaal wel .... echt raar
 
Fout gevonden, na lang speuren :o:o

Deze code stond nog ergens verstopt waardoor ik de foutmelding kreeg

Code: 
Sub ww()
  On Error Resume Next
  ActiveSheet.Unprotect InputBox("voer wachtwoord in", "Beveiliging")
  If Err.Number <> 0 Then MsgBox "Fout Wachtwoord"
End Sub
 
Laatst bewerkt:
Goedemorgen,

Vandaag kom ik er achter dat als ik een rapport op wil slaan ik een foutmelding krijg, waarschijnlijk omdat Excel het blad niet kan vinden omdat het verborgen is.

Is hier een simpele oplossing voor?
 
Als je zegt een foutmelding te krijgen is het wel zo handig deze er ook bij te vermelden.
 
excuses :o

Run-time-error '5:

Invalid procedure call or argument

Hij geeft vervolgens dit stukje code geel

Code: 
 If Not fs.FileExists(ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf") Then 'controle of bestand al bestaat
        
            Sheets("ELEGANZA").Range("A1:K63").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf", _
            OpenAfterPublish:=True 'False
        
        Else
 
Laatst bewerkt:
En wat doet 'ie in de ThisWorkbook_BeforeSave?
 
edmoor zei:
En wat doet 'ie in de ThisWorkbook_BeforeSave?
Klik om te vergroten...

Dit kan ik niet vinden in de code verder

Code: 
 '****************************************************************************************************************
        '**********BESTAND OPSLAAN IN DE VANDAAG AANGEMAAKTE MAP*********************************************************
         
       Set fs = CreateObject("Scripting.FileSystemObject")
        
        
        If Not fs.FileExists(ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf") Then 'controle of bestand al bestaat
        
            Sheets("ELEGANZA").Range("A1:K63").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf", _
            OpenAfterPublish:=True 'False
        
        Else
        
            'msgbox rapport bestaat al in deze map
            Dim RapportOpslaan As Integer
            
            RapportOpslaan = MsgBox("Dit rapport is al opgeslagen, wil je het overschrijven." & vbCrLf & vbCrLf & _
                                    "Klick op JA om te overschrijven." & vbCrLf & vbCrLf & _
                                    "KLick op NEE om het rappport ergens anders op te slaan." & vbCrLf & vbCrLf & _
                                    "Klick op ANNULEREN om af te sluiten." _
                                    , vbYesNoCancel + vbQuestion, "RAPPORT BESTAAT AL!")
            
            
            If RapportOpslaan = vbYes Then
                Sheets("ELEGANZA").Range("A1:K63").ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=ThisWorkbook.Path & "\" & TextBox13.Value & "---" & TextBox25.Value & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf", _
                OpenAfterPublish:=False 'True
            End If
            
            If RapportOpslaan = vbNo Then
                'rapport wordt niet opgeslagen/overschreven maar de keuze geven aan monteur
                With Application.FileDialog(msoFileDialogFolderPicker)
                 .InitialFileName = "c:\users\" & Environ("username") & "\Desktop\" 'Desktop eventueel wijzigen
                 If .Show Then Sheets("ELEGANZA").ExportAsFixedFormat 0, .SelectedItems(1) & "\" & TextBox1.Value & "---" & TextBox2.Value & ".pdf"
                End With
                
            Else
                'knop annuleren
                'userform bijwerken en sluiten
                
            End If
           
            
        End If
        '**********EINDE CODE BESTAND OPSLAAN IN DE VANDAAG AANGEMAAKTE MAP*********************************************************
        '***************************************************************************************************************************
 
Laatst bewerkt:
Ik bedoel dus in de Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
Zie bijlage een bestand met daarin de userform en de volledige code, ik kan niet vinden wat jij bedoelt
 

Bijlagen

Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan