na invoer cel deze blokkeren

[jdrmer]

Goededag dames en heren,

een vraag ik heb diverse codes geprobeerd, maar bij mij werkt het niet.
Ik zou graag willen dat als er een waarde in een cel in de kolom vd maanden is ingevoerd dat dan alleen de cellen worden geblokkeerd met een waarde en alleen kunnen worden gewijzigd door een paswoord in te voeren.
Mvg Jan

 

[edmoor]

Beveilig het hele blad en maak voor het invoeren/wijzigen een userform.

 

[snb]

Waarom geen gebruik van validatie ?

 

[jdrmer]

Goededag, kun je me een hint/advies geven hoe ik dat zou moeten doen?
mvg Jan

 

[gast0660]

Hoi Jan
Test bijgevoegd vbtje
Twee manieren
1ste manier op blad 1 (in uw echte bestand eerst via celeigenschappen de bescherming uitschakelen voor uw bereik ) paswoord = test
2de manier op blad 2 (probeer een ingevulde cel te veranderen)

 

[jdrmer]

Dankjewel gast0660,
versie 2 werkt ook mooi, maar dan kun je nooit meer de ingevoerde cel wijzigen.
mvg Jan

 

[gast0660]

Beste Jan,
Als dit uw probleem is

versie 2 werkt ook mooi, maar dan kun je nooit meer de ingevoerde cel wijzigen.

Dit is normaal de leukste
Pas volgende code aan in mijn vbtje
Blad 2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = "test" Then
Exit Sub
Else
On Error Resume Next
    If Not Application.Intersect(Range("B2:M33"), Range(Target.Address)) _
    Is Nothing Then If Len(Target) > 0 Then Range("A2").Select
    If Err.Number = 91 Then Range("A2").Select
    End If
End Sub

Typ dan maar eens test in in cel A1
Van test kan je natuurlijk appelblauwzeegroen of jantjezageenspruimenhangen maken

 

[jdrmer]

na invoer cel deze blokkeren Uw bericht

Goededag dotchjack, bedankt werkt goed.
Maar de voorkeur gaat uit van een paswoord invoeren, dan jou code deactiveren en na het afsluiten jou code activeren.
Ik ben maar een leek, maar ik heb wat zitten prutsen.
ik had deze code tussen die van jou geplakt, maar dan krijg ik foutmeldingen.
Public Sub voer_paswoord_in()

Const PWORD As String = ""
Dim response As String
Dim msg As String
msg = "Voer wachtwoord in:"
Do
response = Application.InputBox(Prompt:=msg, _
Title:="Password", Type:=2)
If response = CStr(False) Then Exit Sub 'Cancelled
msg = "Incorrect!" & vbNewLine & "Voer opnieuw wachtwoord in:"
Loop Until response = PWORD
Range("A1").Select
ActiveCell.FormulaR1C1 = "test"
Range("A1").Select


End Sub

 

[gast0660]

Hoi,
Probeer deze

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Application.Intersect(Range("B2:M33"), Range(Target.Address)) _
    Is Nothing Then If Len(Target) > 0 Then _
    Antwoord = InputBox("Om deze cel te wijzigen moet je over een beheerderspaswoord beschikken!", "Cel wijzigen!")
If Antwoord = "test" Then
Exit Sub
Else
If Antwoord = "" Or Antwoord <> "test" Or Antwoord = 0 Then
If Not Application.Intersect(Range("B2:M33"), Range(Target.Address)) _
    Is Nothing Then If Len(Target) > 0 Then Range("A2").Select
    If Err.Number = 91 Then Range("A2").Select
    End If
    End If
End Sub

 

[jdrmer]

Hoi gast0660,
dit is het slim gemaakt werkt mooi.
Dankjewel.

 

[jdrmer]

na invoer cel deze blokkeren Uw bericht

Goedeavond gast0660,
kan je me helpen met om jou code toe te wijzen aan een knop.
deze had je voor mij gemaakt;
Ik heb er een regel van gewijzigd, als de cel wordt aangeklikt dan komt de melding deze cel is beveiligd.
Tot zover goed, maar hoe kan ik met een knop, deze manier van cel blokkering tijdelijk stopzetten en na afsluiten file deze celblokkering weer activeren.
mvg Jan
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Application.Intersect(Range("B3:B33,C3:c33"), Range(Target.Address)) _
Is Nothing Then If Len(Target) > 0 Then _
MsgBox " deze cel is beveiligd !"
-----------------------------------------------------------------------------------
'Antwoord = InputBox("eenmalig!", "Cel wijzigen!")
If Antwoord = "xxx" Then
Exit Sub
Else
If Antwoord = "" Or Antwoord <> "xxx" Or Antwoord = 0 Then
If Not Application.Intersect(Range("A1:M33"), Range(Target.Address)) _
Is Nothing Then If Len(Target) > 0 Then Range("e42").Select
If Err.Number = 91 Then Range("e42").Select
End If
End If
End Sub

 

[gast0660]

Beste Jan,
Ik zal morgenvroeg eens kijken wat ik voor u kan betekenen maar plaats aub uw code tussen codetags.
Dit maakt de hele zaak een stuk duidelijker.

 

[jdrmer]

na invoer cel deze blokkeren Uw bericht

Goedeavond gast0660,
heb ik tussen codetags gezet.
Ben een leek, maar ben zelf ook aan het proberen of ik dit werkend krijg.
alvast bedankt.

mvg Jan
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Application.Intersect(Range("B3:B33,C3:c33"), Range(Target.Address)) _
Is Nothing Then If Len(Target) > 0 Then _
< MsgBox " deze cel is beveiligd !" >
-----------------------------------------------------------------------------------
'Antwoord = InputBox("eenmalig!", "Cel wijzigen!")
If Antwoord = "xxx" Then
Exit Sub
Else
If Antwoord = "" Or Antwoord <> "xxx" Or Antwoord = 0 Then
If Not Application.Intersect(Range("A1:M33"), Range(Target.Address)) _
Is Nothing Then If Len(Target) > 0 Then Range("e42").Select
If Err.Number = 91 Then Range("e42").Select
End If
End If
End Sub

 

[gast0660]

Beste Jan,
Helaas niet gelukt, ga naar geavanceerd en druk op #
Edit: Jan ik bedoel de code dat je hier op het forum post
Edit 2 zoiets dus

Uw code

 

[jdrmer]

MsgBox " deze cel is beveiligd !"

bedoel je dit?

 

[gast0660]

Hoi beste Jan,
idd, maar dan voor de volledige code , dit is in dit geval niet direct voor mij, maar voor alle helpers op dit forum,dit maakt uw vraag of een andere vraag in de toekomst betreffende code een stuk duidelijker.
De code die je wil aanpassen heb ik natuurlijk en daar kijk ik morgenvroeg wel naar.

 

[jdrmer]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 On Error Resume Next
 If Not Application.Intersect(Range("B3:B33,C3:c33"), Range(Target.Address)) _
 Is Nothing Then If Len(Target) > 0 Then _
 < MsgBox " deze cel is beveiligd !" >
-----------------------------------------------------------------------------------
'Antwoord = InputBox("eenmalig!", "Cel wijzigen!")
 If Antwoord = "xxx" Then
 Exit Sub
 Else
 If Antwoord = "" Or Antwoord <> "xxx" Or Antwoord = 0 Then
 If Not Application.Intersect(Range("A1:M33"), Range(Target.Address)) _
 Is Nothing Then If Len(Target) > 0 Then Range("e42").Select
 If Err.Number = 91 Then Range("e42").Select
 End If
 End If
 End Sub

 

[VenA]

Volgens mij is dit een zeer vervelende methode om gegevens in te laten voeren. Daarnaast worden wachtwoorden voor verschillende applicaties tussen collega's nogal eens uitgewisseld. Meestal wordt het wachtwoord voor het inloggen op een Windows systeem niet zo snel gedeeld:d Maak dus gebruik van gebruikersnaam van Windows.

 

[jdrmer]

Goededag heren,
bedankt voor deze code, echter kan ik deze niet in mijn situatie toepassen.

Is het mogelijk om de onderstaande code zo aan te passen dat deze met een paswoord tijdelijk uit wordt gezet en bij het afsluiten dat deze code wordt aangezet.
Ik hoop dat ik het begrijpelijk heb uitgelegd.
Dus deze manier van de cellen blokkeren is voor ideaal.
mvg Jan

vanaf hier de code met paswoord tijdelijk uit zetten.
On Error Resume Next
If Not Application.Intersect(Range("B2:M33"), Range(Target.Address)) _
    Is Nothing Then If Len(Target) > 0 Then _
   
Exit Sub
Else

If Not Application.Intersect(Range("B2:M33"), Range(Target.Address)) _
    Is Nothing Then If Len(Target) > 0 Then Range("A2").Select
    If Err.Number = 91 Then Range("A2").Select
    End If
    End If
End Sub

 

[VenA]

En waarom is het in jouw situatie niet toe te passen?

Waarom neem je twee keer dezelfde voorwaarde op?

If Not Application.Intersect(Range("B2:M33"), Range(Target.Address)) _
    Is Nothing Then If Len(Target) > 0 Then

Dit kan je ook wel wat eenvoudiger schrijven.

If Not Intersect(Target, Range("B2:M33")) Is Nothing Then