commandbutton voorzien van een wachtwoord

[rkootje]

Hallo,
ik heb een commandbutton voor accorderen van uren, nu heb ik een userform met txtbox waar je het wachtwoord moet invullen, indien juist dan komt dien er een vakje groen te kleuren met een tekst akk. ik ben wat aan het stoeien geweest, maar weet niet goed hoe ik dit op los, kan iemand mij hiermee helpen?
ik het de code wat ik heb geprobeerd hieronder staan, alvast bedankt!

Private Sub cmbwwoke_Click()

If Txtww = Not "Alfred" Then
MsgBox "Wachtwoord onjuist"



    Range("B4:E4").Select
    ActiveCell.FormulaR1C1 = "Acc. AKL"
    Range("B4:E4").Select
    With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
End If
    Unload Me
    
End Sub

 

[edmoor]

Zoiets?

Private Sub cmbwwoke_Click()

If Txtww <> "Alfred" Then
    MsgBox "Wachtwoord onjuist"
Else
    Range("B4:E4").Select
    ActiveCell.FormulaR1C1 = "Acc. AKL"
    Range("B4:E4").Select
    With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
End If
Unload Me
    
End Sub

 

[rkootje]

Dank Edmoor, maar weet je hier ook iets op?

allereerst bedankt, soms zie ik het blijkbaar allemaal niet zo zuiver meer, verder in het document had ik zoiets ook al gedaan, heb zeker zitten slapen.

maar ik heb nog wel een ander vraagje over hetzelfde document,
Het document is een urenverantwoording, ik heb op 1 werkblad alle 52 weken gezet, en deze per week geselecteerd en hier een naam aangegeven in het naamvak, Week1, Week2 enz. op het 1e blad heb ik een keuzelijst gemaakt met invoervak. als je een week selecteerd, dan krijg je die week in blad 1 te zien. nu wil ik, wanneer je druk op de cmb acc registratie dat de gegevens worden gekopieerd naar dat zelfde weeknummer op blad "gegevens" en dat lukt ook wel, maar je ziet veel gefikker tijdens het wisselen van de bladen, ook dient het werkblad beveiligd te zijn en wanneer de gegevens worden toegevoegd dient het blad van de beveiliging gehaalt te worden, en daar na weer opnieuw beveiligd.

Private Sub CommandButton1_Click()
If Cells(4, 2) = "" Then

    Application.Goto Reference:="copie"
    Selection.Copy
    Application.Goto Reference:=Me.Cbbkeuzeweek
    ActiveSheet.Paste
    Application.Goto Reference:="copie"
    Application.CutCopyMode = True
   Range("A1").Select
   'wanneer de gegevens zijn gekopieerd, dan dient het blad beveligd te zijn.
   'wanneer de uren zijn geaccordeerd (cel B4 staat tekst) dan kan er geen uren worden toegevoegd/veranderd
   Else
   MsgBox "kan niet worden gewijzig, uren zijn al geaccordeerd"
   End If
 

End Sub

 

[edmoor]

Het beveiligen weet ik zo even niet uit het hoofd maar dat geflikker kun je denk ik wel onderdrukken door op het juiste moment in je routine de screenupdate uit te zetten en weer aan als het weer mag.

Application.ScreenUpdating=False
...
...
...
Application.ScreenUpdating=True

 

[rkootje]

top dank je, werkt prima zo,

moet ik alleen even kijken of ik voor het andere nog wat vind.
wellicht weet iemand anders hiervoor een oplossing.

gr. Rkootje

 

[OctaFish]

Dat is relatief simpel te doen:

Verwijder de beveiling met:

ActiveSheet.Unprotect Password:="x"

En stel opnieuw in met:

ActiveSheet.Protect Password:="x", UserInterfaceOnly:=False

 

[rkootje]

werkt niet

Hoi Octafish,

zoiets had ik ook al, maar als het blad beveiligd is, geeft deze een foutmelding, of wellicht heb ik weer een foutje gemaakt,
zie code,
het stopt dan bij ActiveSheet.Paste

Private Sub CommandButton1_Click()
If Cells(4, 2) = "" Then
Application.ScreenUpdating = False

    Application.Goto Reference:="copie"
    Selection.Copy
    Application.Goto Reference:=Me.Cbbkeuzeweek
        ActiveSheet.Unprotect Password:="x"
    ActiveSheet.Paste
        ActiveSheet.Protect Password:="x", UserInterfaceOnly:=False
    Application.Goto Reference:="copie"
    Application.CutCopyMode = True
   
   Range("A1").Select
   Application.ScreenUpdating = True
   'wanneer de gegevens zijn gekopieerd, dan dient het blad beveligd te zijn.
   'wanneer de uren zijn geaccordeerd (cel B4 staat tekst) dan kan er geen uren worden toegevoegd/veranderd
   Else
   MsgBox "kan niet worden gewijzig, uren zijn al geaccordeerd"
   End If
 

End Sub

verder heb ik nog een vraagje, ik wil de gegevens kopieren naar het blad "gegevens"
de bereiken heb ik via naamvak een naam gegeven, zoals Week1, Week2 enz.
deze weken selecteer ik dan via een keuzelijst met invoervak, deze is opgenomen in blad1, als ik via een userform verwijs naar de uitkomst van dit keuzelijst ( Week1 o.i.d.) kent die dit niet, moet ik verwijzen naar het werkblad waar dit keuzelijst (Ccbkeuzeweek) is ingevoegd, en hoe dan?

alvast bedankt.

 

[OctaFish]

Het is niet nodig om met Copy en Paste te werken, dus je code kan een heel stuk simpeler. Waar het verder fout gaat is lastig te zien, maar misschien heb je het werkblad nog niet beveiligd met het 'wachtwoord' uit de code. Je kunt een wachtwoord uiteraard pas uitzetten als het (correct) is ingesteld. Met VBA gebruik je daarom een vast wachtwoord, want voor het instellen en opheffen heb je hetzelfde wachtwoord nodig. In mijn voorbeeld is dat x.

If Cells(4, 2) = "" Then
   Application.ScreenUpdating = False
   ActiveSheet.Unprotect Password:="x"
   Range(Me.Cbbkeuzeweek).Value = Range("copie").Value
   Range("A1").Select
   Application.ScreenUpdating = True
   ActiveSheet.Protect Password:="x", UserInterfaceOnly:=False
Else
   MsgBox "kan niet worden gewijzig, uren zijn al geaccordeerd"
End If

 

[rkootje]

Werkt niet,

Ik heb het blad beveiligd en het wachtwoord ook vermeld in de code, maar hij blijft vastlopen op de regel Range(Me.Cbbkeuzeweek).Value = Range("copie").Value

Private Sub cmbAfdrukken_Click()
'Als de uren nog niet zijn geaccordeerd, (dus cel B4 leeg is) dan
'melding via Msgbox
'Wel geaccordeerd dan gegevens plaatsen in cel F4 "ingeboekt"
If Cells(4, 2) = "" Then
   Application.ScreenUpdating = False
   ActiveSheet.Unprotect Password:="vandaag"
   Range(Me.Cbbkeuzeweek).Value = Range("copie").Value
   Range("A1").Select
   Application.ScreenUpdating = True
   ActiveSheet.Protect Password:="vandaag", UserInterfaceOnly:=False
Else
   MsgBox "kan niet worden gewijzig, uren zijn al geaccordeerd"
   
 End If

 

[OctaFish]

Dan haal je op de verkeerde manier een waarde uit je keuzelijst, vermoed ik. Omdat ik het formulier niet heb, heb ik getest met het kopieeren van de ene cel naar de andere, en dat werkt prima. Kijk dus eerst eens met een Msgbox wat er uit je keuzelijst wordt opgehaald.

 

[rkootje]

Hoi Octafish

Bekijk bijlage Test urenregistratiemail.zipik heb dezelfde verwijzig naar een ander command button, waar die wel werkt, zoals bij afdrukken en akk registratie.
Maar ik wil het blad gegevens beveiligen zodat er daar niets veranderd kan worden, wanneer de uren eenmal zijn geaccordeerd, als ik de regels toevoeg om het blad te beveiligen, werkt het niet.
dan loopt die vast.
ik heb het bestandje gezipt en bijgevoegd, wellicht kun je dan zien wat ik bedoel.

alvast bedankt voor je hulp.

Gr. Rkootje

 

[edmoor]

Ik heb het blad beveiligd en het wachtwoord ook vermeld in de code, maar hij blijft vastlopen op de regel Range(Me.Cbbkeuzeweek).Value = Range("copie").Value

"Hij blijft vastlopen" is niet voldoende informatie.
Je krijgt er vast een melding op. Welke is dat?

 

[rkootje]

Hoi Edmoor

Ik heb een zipbestandje van het document bij gevoegd bij mijn vorige mail.
ik krijg een foutmelding wanneer ik op de knop druk van akkoord uren, je krijgt dan een userform, waar je als wachtwoord Alfred in typt. wanneer je daarna op oke drukt, dient het volgende te gebeuren, B4 op "Blad1" dient dan groen te worden en van text te voorzien van acc.AKL. daarna dienen de gegevens uit het bereik "copie" geplaatst te worden in het bereik welke vermeld staat in Ccbkeuzeweek.( hier loopt die op vast) melding "Compileerfout, kan methode of gegevenslid niet vinden. tewijl de code onder een ander knop wel werkt. verder is het de bedoeling dat Blad1 beveilig blijft, zodat men in dit overzicht (blad Gegevens) geen gegevens kan wijzigen.
ik heb het geprobeerd met unprotect en daarna protect, maar dan geeft die ook foutmeldingen.
ik hoop dat jij me kan helpen?

 

[edmoor]

Wijzig in Private Sub cmbwwoke_Click()
de regel
Application.Goto Reference:=Me.Cbbkeuzeweek
eens in
Application.Goto Reference:=ActiveSheet.Cbbkeuzeweek

 

[rkootje]

Top, dank je.

het werkt, zit ik alleen nog met het beveiligen van het blad, daar heb je geen goede oplossing voor ??

in iedergeval bedankt!

 

[edmoor]

Dat zou moeten werken zoals OctaFish heeft verteld.

 

[rkootje]

Dank jullie beiden!

het werkt, ik had de regel om te beveiligen te laat in de code staan!
dank beide voor je input!

 

[edmoor]

Namens OctaFish en mezelf, graag gedaan

 

[rkootje]

iets te vroeg gejuigt

Wanneer de sheet beveiligd is en je wil weer via een macro de sheet van de beveiliging weg halen loppt die vast, de regel van unprotect heb ik nu op diverse getracht te plaatsen, moet er wellicht verwezen worden naar de betreffende sheet?

de code stopt bij, "ActiveSheet.Paste"

Private Sub cmbwwoke_Click()
If Txtww <> "Alfred" Then 'wachtwoord aanpassen aan gebruiker
MsgBox "Wachtwoord onjuist"
Else



    Range("B4:E4").Select
    ActiveCell.FormulaR1C1 = "Acc. AKL" 'initialen wijzigen aan gebruiker
    Range("B4:E4").Select
    With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
End If

    Application.ScreenUpdating = False
        Application.Goto Reference:="copie"
    Selection.Copy
    
    Application.Goto Reference:=ActiveSheet.Cbbkeuzeweek
     ActiveSheet.Unprotect Password:="x"
   

    ActiveSheet.Paste
     ActiveSheet.Protect Password:="x", UserInterfaceOnly:=False
    Application.Goto Reference:="copie"
    Application.CutCopyMode = True
 
   

   Range("A1").Select
   Application.ScreenUpdating = True

    Unload Me
    
End Sub

 

[edmoor]

Altijd even de foutmelding erbij vermelden.