geselecteerde optionbox vertalen naar text in cel (in volgende lege rij)

[SjonR]

Hallo allemaal,

Ik heb een userform waarbij ik de data wegschrijf naar de eerstvolgende lege regel in blad 1. Dat werkt perfect met textboxes en comboboxes, maar hoe ik het voor elkaar krijg met de optionbuttons is mij een raadsel.

Bekijk bijlage voorbeelduserfom.xlsm

ik heb tussen de werkende code omschreven welke wens ik heb voor een optionbutton of groepje optionbuttons.

Ook heb ik een probleempje met de weergegeven datum op het userform bij aanmaakdatum. Hij geeft een getal ipv een datum. Het wordt wel goed weggeschreven naar blad1, maar het zou prettig zijn als het ook in de userform als datum wordt weergegeven.

Ik hoop dat iemand hier iets op kan vinden

Private Sub CommandButton1_Click()
   Dim LastRow As Long, ws As Worksheet

    Set ws = Blad1
    
    
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1

    ws.Range("A" & LastRow).Value = reg1.Text
    ws.Range("B" & LastRow).Value = reg2.Text
    ws.Range("c" & LastRow).Value = reg3.Text
    'In kolom D moet "goed" of "fout" worden gevuld op basis van Optionbuttons OB1 of OB2
    'In kolom E moet "ja" worden gevuld als de optie Spelling (FOUT4) is aangeklikt
    'In kolom F moet "ja" worden gevuld als de optie Grammatica (FOUT2) is aangeklikt
    'In kolom G moet "ja" worden gevuld als de optie Zinsopbouw(FOUT3) is aangeklikt
    ws.Range("H" & LastRow).Value = TB1.Text
    ws.Range("I" & LastRow).Value = cmb1.Text
    ws.Range("J" & LastRow).Value = TB5.Text


    Dim lReply As Long
    Dim strFind As String
     
     
    Set wsh = Worksheets("Blad2")
    strFind = Me.reg1
     
    With wsh.UsedRange.Columns(1)
        If WorksheetFunction.CountIf(.Cells, strFind) <> 0 Then
            .Cells.Find(What:=strFind, After:=.Cells(1, 1), MatchCase:=True).EntireRow.Delete
        Else
            MsgBox "Could not find " & strFind & " on " & ws.Name, vbCritical
            Exit Sub
        End If
    End With
     
     
    strFind = "VO" & strFind
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(strFind).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
     
    Unload Me
     
End Sub

 

[OctaFish]

Laat ik beginnen met zeggen dat je de verkeerde objecten gebruikt; als je verschillende opties wilt aanbieden aan een gebruiker die tegelijkertijd geldig kunnen zijn, gebruik je selectievakjes en geen optierondjes. Die zijn bedoeld voor keuzes waarbij je maar één keuze mag maken. Elke gebruiker weet dat, en verwacht dat van een formulier. Als je met die mores gaat rotzooien, breng je de gebruiker in verwarring. Maar goed, je zou het zo kunnen doen:

    If Me.OB1.Value = True Then ws.Range("D" & LastRow).Value = "Goed"
    If Me.OB2.Value = True Then ws.Range("D" & LastRow).Value = "Fout"
    If Me.fout2.Value = True Then ws.Range("E" & LastRow).Value = "Ja" Else: ws.Range("D" & LastRow).Value = ""
    If Me.fout3.Value = True Then ws.Range("F" & LastRow).Value = "Ja" Else: ws.Range("D" & LastRow).Value = ""
    If Me.fout4.Value = True Then ws.Range("G" & LastRow).Value = "Ja" Else: ws.Range("D" & LastRow).Value = ""

 

[VenA]

Als aanvulling op de wijze woorden van OctaFish (zonder het toegepast te hebben):d. Maak zinvol gebruik van comboboxen. Elke keer zoeken in een blad is nergens voor nodig.

 

[SjonR]

Octafish en VenA,

hartelijk dank voor jullie antwoord.

Ik heb, omdat ik zelf ook wil kunnen begrijpen wat de code doet, voor de aanvulling van Octafish gekozen.

het enige probleem wat ik dan nog heb, is het feit dat de datum in textbox "reg3" als nummer wordt vermeld.

VenA,

in jouw code heb je dit wel opgelost, maar ik weet niet goed hoe ik "Cdate" in mijn code kan toepassen.

Kan jij hierbij helpen?

Gr.

Sjon

Private Sub CommandButton1_Click()
   Dim LastRow As Long, ws As Worksheet

    Set ws = Blad1
    
    
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1

    ws.Range("A" & LastRow).Value = reg1.Text
    ws.Range("B" & LastRow).Value = reg2.Text
    ws.Range("C" & LastRow).Value = reg3.Text
    ws.Range("D" & LastRow).Value = reg4.Text
    If Me.OB1.Value = True Then ws.Range("E" & LastRow).Value = "Goed"
    If Me.OB2.Value = True Then ws.Range("E" & LastRow).Value = "Fout"
    If Me.fout2.Value = True Then ws.Range("F" & LastRow).Value = "Ja" Else: ws.Range("E" & LastRow).Value = ""
    If Me.fout3.Value = True Then ws.Range("G" & LastRow).Value = "Ja" Else: ws.Range("E" & LastRow).Value = ""
    If Me.fout4.Value = True Then ws.Range("H" & LastRow).Value = "Ja" Else: ws.Range("E" & LastRow).Value = ""
    ws.Range("I" & LastRow).Value = TB1.Text
    ws.Range("J" & LastRow).Value = cmb1.Text
    ws.Range("K" & LastRow).Value = TB5.Text


    Dim lReply As Long
    Dim strFind As String
     
     
    Set wsh = Worksheets("Blad2")
    strFind = Me.reg1
     
    With wsh.UsedRange.Columns(1)
        If WorksheetFunction.CountIf(.Cells, strFind) <> 0 Then
            .Cells.Find(What:=strFind, After:=.Cells(1, 1), MatchCase:=True).EntireRow.Delete
        Else
            MsgBox "Could not find " & strFind & " on " & ws.Name, vbCritical
            Exit Sub
        End If
    End With
     
     
    strFind = "VO" & strFind
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(strFind).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
     
    Unload Me
     
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub


Private Sub OB2_Click()
Dim objCtrl As Control

For Each objCtrl In Me.Controls
If OB2.Value Then objCtrl.Visible = True

Next
End Sub

Private Sub OB1_Click()
fout1.Visible = False
fout2.Visible = False
fout3.Visible = False
fout4.Visible = False

fout2.Value = False
fout3.Value = False
fout4.Value = False

End Sub

Private Sub cmb1_AfterUpdate()
 'Check to see if value exists
 If WorksheetFunction.CountIf(Blad3.Range("A:A"), Me.cmb1.Value) = 0 Then
 MsgBox "medewerker komt niet voor in bestand"
 Me.cmb1.Value = ""
 Exit Sub
 End If
 'Lookup values based on first control
 With Me
 .TB5 = Application.WorksheetFunction.VLookup((Me.cmb1), Blad3.Range("medewerkers"), 2, 0)
 
 End With
 End Sub
 
 Private Sub Reg1_AfterUpdate()
 'Check to see if value exists
 If WorksheetFunction.CountIf(Blad2.Range("A:A"), Me.reg1.Value) = 0 Then
 MsgBox "This is an incorrect ID"
 Me.reg1.Value = ""
 Exit Sub
 End If
 'Lookup values based on first control
 With Me
 .reg2 = Application.WorksheetFunction.VLookup(CLng(Me.reg1), Blad2.Range("Lookup"), 2, 0)
 .reg3 = Application.WorksheetFunction.VLookup(CLng(Me.reg1), Blad2.Range("Lookup"), 3, 0)
 .reg4 = Application.WorksheetFunction.VLookup(CLng(Me.reg1), Blad2.Range("Lookup"), 4, 0)
 End With
 End Sub



Private Sub UserForm_Initialize()
Dim objCtrl As Control


For Each objCtrl In Me.Controls
If Left(objCtrl.Name, 4) = "fout" Then objCtrl.Visible = False
Next

Me.reg3.Value = Format(reg3.Value, "dd-mm-yyyy")

End Sub


Private Sub UserForm_Activate()
     
    Me.StartUpPosition = 0
    Me.Top = Application.Top + 25
    Me.Left = Application.Left + 100
     
End Sub

 

[OctaFish]

Lijkt mij niet zo moeilijk...

ws.Range("C" & LastRow).Value = Cdate(reg3.Text)

 

[SjonR]

Datum als getal in textbox in Userform

Octafish,

bedankt voor je snelle antwoord. De datum wordt sowieso goed weggeschreven naar kolom c van blad 1, maar de datum die ik met Vlookup in textbox "reg3" laat plaatsen wordt weergegeven als getal ( bijv. 42659).

Ik zou graag willen dat de datum goed wordt weergeven in de bewuste textbox.

Ik heb al geprobeerd met reg3.value = Format(reg3.value, "dd-mm-yyyy"). Echter geen resultaat.

Gr.

Sjon

Ik had graag een VB-bestand willen posten, maar die zit inmiddels vol met gegevens welke ik niet mag delen. Dus als het zonder voorbeeldbestand lukt graag. Indien niet, dan heb ik geen keuze om het leeg te halen.

Gr.

Sjon

 

[OctaFish]

Bedoel je dit?

     With Me
        .reg2 = Application.WorksheetFunction.VLookup(CLng(Me.reg1), Blad2.Range("Lookup"), 2, 0)
        .reg3 = CDate(Application.WorksheetFunction.VLookup(CLng(Me.reg1), Blad2.Range("Lookup"), 3, 0))
     End With

 

[SjonR]

Octafish,

het is precies wat ik bedoel en is achteraf ook heel eenvoudig, maar ik kwam er niet op.

Wederom bedankt voor je snelle antwoord.

Gr.

Sjon