• 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.

Code met dubbele commando's ?

Status
Niet open voor verdere reacties.

hoogteijling

Terugkerende gebruiker
Lid geworden
12 aug 2005
Berichten
4.261
Hallo allemaal,

Het 1e deel van de onderstaande code staat in een bestand, het 2e deel heb ik toegevoegd maar nu werkt het niet meer.
Zal ongetwijfeld komen omdat er dingen dubbel instaan.
Kan iemand de code aanpassen zodat het wel werkt.

Het 1e deel van de code kijkt of er in cel C Ja of Nee ingevuld is en aan de hand daarvan blokkeert ie cel D wel of niet.

Het 2e deel van de code zorgt ervoor dat je in cel E een 4-cijferig nummer in kunt vullen waarna hij er een puntje inzet.

De codes werken wel als ik of de 1e of de 2e gebruik maar ze moeten samen te gebruiken zijn natuurlijk.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column & Target.Offset(, 1) = "3" Then
    Unprotect
    Target.Offset(, 1) = IIf(Target = "Nee", Target.Offset(, -1), "")
    Protect , AllowFiltering:=True
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Application.EnableEvents = False
  If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
  If Not IsEmpty(Target) Then
   If IsNumeric(Target) Then
    Select Case Len(Target)
      Case 4
         Target.Characters(2, 0).Insert (".")
     End Select
    End If
   End If
  End If
Application.EnableEvents = True
End Sub

Groeten Marcel
Bekijk bijlage Opschoon formulier.zip
 
Laatst bewerkt:
Je kunt geen 2 Change events in VBA gebruiken.
Bovendien lijkt mij de 2e Event overbodig omdat je dit met de celeigenschappen in kunt stellen.

Met vriendelijke groet,


Roncancio
 
Bedankt voor je reactie,

De celnotatie moet op tekst blijven staan omdat dit bestand weer gegevens uit een ander bestand haalt.
In de cel moet dus echt 0.000 staan.
Iemand nog ideeën ?

Groeten Marcel
 
zou het zo werken?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Column & Target.Offset(, 1) = "3" Then
    Unprotect
      Target.Offset(, 1) = IIf(Target = "Nee", Target.Offset(, -1), "")
    Protect , AllowFiltering:=True
  End If

Application.EnableEvents = False
  If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
  If Not IsEmpty(Target) Then
   If IsNumeric(Target) Then
    Select Case Len(Target)
      Case 4
         Target.Characters(2, 0).Insert (".")
     End Select
    End If
   End If
  End If
Application.EnableEvents = True

End Sub
 
Laatst bewerkt:
Helaas, dit werkt niet,

Wanneer ik een nummer zonder puntje intyp komt er een fout (rood gemarkeerd).
Wanneer ik een nummer met puntje intyp gaat het wel gewoon goed (maar dat was al zo).
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="#FF0000"]  If Target.Column & Target.Offset(, 1) = "3" Then[/COLOR]
    Unprotect
      Target.Offset(, 1) = IIf(Target = "Nee", Target.Offset(, -1), "")
    Protect , AllowFiltering:=True
  End If
Application.EnableEvents = False
  If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
  If Not IsEmpty(Target) Then
   If IsNumeric(Target) Then
    Select Case Len(Target)
      Case 4
         Target.Characters(2, 0).Insert (".")
     End Select
    End If
   End If
  End If
Application.EnableEvents = True
End Sub

Groeten Marcel
 
Los van elkaar werkte het wel?

Eigenlijk heb ik enkel deze 2 regels in het midden verwijderd.
Code:
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 
Wat die 2 rode regels beogen weet ik niet maar deze code zou moeten doen wat je vraagt:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 With Application
       .EnableEvents = False
  [COLOR="#FF0000"]'If Target.Column & Target.Offset(, 1) = "3" Then[/COLOR]   
     ActiveSheet.Unprotect
      Target.Offset(, 1) = IIf(Target = "Nee", Target.Offset(, -1), "")
 [COLOR="#FF0000"] 'End If[/COLOR]
  Range(Target.Address).NumberFormat = "0,000"
Oeps:
     ActiveSheet.Protect , AllowFiltering:=True
    .EnableEvents = True
  End With
End Sub
 
Het 1e deel van de code kijkt of er in cel C Ja of Nee ingevuld is en aan de hand daarvan blokkeert ie cel D wel of niet.

Daarvoor kun je veel eenvoudiger datavalidatie gebruiken.
 
Laatst bewerkt:
Cobbejaan, als ik jouw code gebruik moet ik het puntje zelf intypen en wanneer ik de rode code niet gebruik wordt de formule die in kolom F staat gewist.
Ik heb zelf nog wat stukjes bij elkaar geplakt en de code is nu als volgt en werkt uitstekend:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 With Application
       .EnableEvents = False
       If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
  If Not IsEmpty(Target) Then
   If IsNumeric(Target) Then
    Select Case Len(Target)
      Case 4
         Target.Characters(2, 0).Insert (".")
     End Select
    End If
   End If
  End If
  If Target.Column & Target.Offset(, 1) = "3" Then
     ActiveSheet.Unprotect
      Target.Offset(, 1) = IIf(Target = "Nee", Target.Offset(, -1), "")
  End If
  Range(Target.Address).NumberFormat = "0,000"
Oeps:
     ActiveSheet.Protect , AllowFiltering:=True
    .EnableEvents = True
  End With
End Sub
Wel heb ik het idee dat het onderstaande stukje code geen nut meer heeft want die zorgt ervoor dat de cel niet meer op celnotatie TEKST komt te staan en hij moet echt op TEKST blijven staan:
Code:
Range(Target.Address).NumberFormat = "0,000"

Groeten Marcel
 
Laatst bewerkt:
SNB, bedankt voor je inbreng maar het volgende is de bedoeling:

Kies Nee: D neemt de waarde over uit B en D wordt vervolgens geblokkeerd.
Kies Ja: D is vrij invulbaar (datum)
Bij het voorbeeld wat jij stuurt kan ik idd Ja of Nee kiezen d.m.v. validatie maar verder gebeurd er niets voor zover ik kan zien.

Groeten Marcel
 
Probeer eens iets in te vullen in de andere gekleurde cel als in de cel met validatie ja/nee 'nee' is ingevuld.
 
Top, grappig dat we het zo ver zochten.
Maar ik begrijp de formule niet helemaal.
Want hoe krijg ik nu voor elkaar dat D de waarde uit B overneemt als C Nee is.
Code:
=C5="ja"

Groeten Marcel
 
Laatst bewerkt:
Weet iemand nog een antwoord op mijn vorige post ?
Mijn vraag is bij nader inzien nog niet 100% opgelost.
Want hoe krijg ik nu voor elkaar dat D de waarde uit B overneemt als C "Nee" is.

Groeten Marcel
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan