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

Checkbox vraagje

Status
Niet open voor verdere reacties.
D

daghengst

Gebruiker
Lid geworden
16 apr 2015
Berichten
32
Hallo iedereen, ik heb een vraagje over checkbox. Ik heb namelijk een voorschouw formulier opgezet waar me je meteen een richtprijs kan aangeven bij klanten.
Bij een bepaalde keuze dien je een keuzevakje op tabblad 1 (voorschouw formulier) aan te vinken waarmee een calculatieregel vanaf tabblad 3 op een volgende lege regel wordt geplaatst op het calculatieblad (tabblad 2). Dat is gelukt middels onderstaande code:

Code: 
Private Sub CheckBox1_Click()
    If CheckBox1.Value = True Then
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("calculatie")

'vindt laatst gebruikte cel, ga naar de volgende rij
iRow = ws.Cells(Rows.Count, 7) _
.End(xlUp).Offset(1, 0).Row

'plaatst de gegevens in de database
ws.Cells(iRow, 6).Value = "='omschrijving'!f3"
ws.Cells(iRow, 7).Value = "='omschrijving'!g3"
ws.Cells(iRow, 8).Value = "='omschrijving'!h3"
ws.Cells(iRow, 9).Value = "='omschrijving'!i3"
ws.Cells(iRow, 10).Value = "='omschrijving'!j3"
ws.Cells(iRow, 11).Value = "='omschrijving'!k3"
ws.Cells(iRow, 12).Value = "='omschrijving'!l3"

'vindt laatst gebruikte cel, ga naar de volgende rij
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
        
    End If
End Sub

Dit werkt prima, echter als ik het selektievakje weer uitzet en daarna weer aanvink worden meerdere regels aangemaakt.

Kan ik iets toevoegen aan bovenstaande code zodat de ingevulde tekst bij uitzetten van het selektievakje weer wordt gewist en wanneer het selektievakje weer wordt aangevinkt de betreffende regel maar één keer wordt geplaatst?

Alvast bij voorbaat bedankt.

Groetjes Hans
 
Zonder voorbeeld document kan dit weer veel vragen opleveren.
Maar probeer dit eens:
Code: 
Private Sub CheckBox1_Click()
    Static iRow As Long
    Dim ws As Worksheet
    If CheckBox1.Value Then
        Set ws = Worksheets("calculatie")
        
        'vindt laatst gebruikte cel, ga naar de volgende rij
        iRow = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row
        
        'plaatst de gegevens in de database
        ws.Cells(iRow, 6).Value = "='omschrijving'!F3"
        ws.Cells(iRow, 7).Value = "='omschrijving'!G3"
        ws.Cells(iRow, 8).Value = "='omschrijving'!H3"
        ws.Cells(iRow, 9).Value = "='omschrijving'!I3"
        ws.Cells(iRow, 10).Value = "='omschrijving'!J3"
        ws.Cells(iRow, 11).Value = "='omschrijving'!K3"
        ws.Cells(iRow, 12).Value = "='omschrijving'!L3"
        
        'vindt laatst gebruikte cel, ga naar de volgende rij
        iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Else
        ws.Cells(iRow, 6).Resize(, 7).ClearContents
    End If
End Sub
 
Laatst bewerkt:
De code zelf is altijd afhankelijk van het document, dus een voorbeeld is meestal wel gewenst :)
Ik laat het in de bekwame handen van gast0660 want ik moet nu weg.
 
zo?

Code: 
Private Sub CheckBox1_Click()
Dim iRow As Long
Dim ws, ws2 As Worksheet
Set ws = Worksheets("calculatie")
Set ws2 = Sheets("omschrijving")
iRow = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row
    
If CheckBox1 Then
    If Application.CountIf(ws.Range("F7:F100"), ws2.Range("F3").Value) > 0 Then
        Exit Sub
    Else
        For I = 6 To 12
                ws.Cells(iRow, I).Value = ws2.Cells(3, I).Value
        Next I
    End If
Else
ws.Range("F7:F100").Find(ws2.Range("F3").Value).Resize(1, 7).ClearContents
End If
End Sub
 
Laatst bewerkt:
SjonR zei:
zo?

Code: 
Private Sub CheckBox1_Click()
Dim iRow As Long
Dim ws, ws2 As Worksheet
Set ws = Worksheets("calculatie")
Set ws2 = Sheets("omschrijving")
iRow = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row
    
If CheckBox1 Then
    If Application.CountIf(ws.Range("F7:F100"), ws2.Range("F3").Value) > 0 Then
        Exit Sub
    Else
        For I = 6 To 12
                ws.Cells(iRow, I).Value = ws2.Cells(3, I).Value
        Next I
    End If
Else
ws.Range("F7:F100").Find(ws2.Range("F3").Value).Resize(1, 7).ClearContents
End If
End Sub
Klik om te vergroten...

Sorry voor de late reactie, maar ik heb een tijdje in het ziekenhuis gelegen waardoor ik niet kon reageren.

In ieder geval: ja, dit werkt perfect!!! Hartstikke bedankt....

Me so happy!!!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan