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

cell invullen aan de hand van datum van dtpicker

Status
Niet open voor verdere reacties.

bjornesto

Gebruiker
Lid geworden
16 apr 2012
Berichten
201
Beste

Ik heb een userform met daarin een datum.
Eens men alles heeft ingevuld, gaat de computer eerst een lijst invullen op huidige worksheet en dan gaat hij worksheets (2) selecteren en zoeken naar de naam.
Staat deze in de lijst gaat hij die cell selecteren.
Staat hij niet in de lijst gaat hij de naam van de persoon er automatisch onder zetten. (deze code werkt)

Echter zou ik aan de hand van de maand moeten bepalen waar hij een bepaalde waarde moet zetten in een ander worksheet.

kun je hiervoor select case gebruiken of niet

voorbeeld datum is = 12/05/2017 dan zou hij de waarde in worksheets (2) kolom 6 moeten zetten

Hier is de code die de lijst invult en dan naar de worksheet gaat aan de hand wat er van ingevuld is
Code:
Private Sub CommandButton1_Click()

'check userform if field has been filled in
If Me.cmbbx_nom_du_poste_client_NOH.Value = NullString Then
    MsgBox ("please fill in the following" & vbNewLine & "     - " & Me.lbl_nom_du_poste_client_NOH.Caption), vbInformation, "Please fill in field"
Me.cmbbx_nom_du_poste_client_NOH.SetFocus
Exit Sub
End If

ThisWorkbook.Worksheets(6).Select

'find first empty cell counted from the buttom of column B
With ActiveWorkbook.Worksheets(4)
Range("B65536").End(xlUp).Offset(1, 0).Select
End With

On Error Resume Next
'set data from userform in activecell
With ActiveCell
.Offset(0, 0) = Me.txtbx_po                                  'heading cell B6
.Offset(0, 1) = Me.DTPicker1                                 'heading cell C6
.Offset(0, 2) = Me.DTPicker1                                 'heading cell D6
.Offset(0, 3) = Me.cmbbx_nom_du_poste_client_NOH             'heading cell E6
.Offset(0, 4) = Me.cmbbx_personne_de_contact_rencontrees     'heading cell F6
.Offset(0, 5) = Me.DTPicker3                                 'heading cell G6
.Offset(0, 6) = Me.ComboBox3                                 'heading cell H6
.Offset(0, 7) = Me.ComboBox6                                 'heading cell I6
.Offset(0, 8) = Me.DTPicker2                                 'heading cell J6
.Offset(0, 9) = Me.TextBox1                                  'heading cell K6
.Offset(0, 10) = Me.TextBox2                                 'heading cell L6
.Offset(0, 11) = Me.txtbx_contenu_action_entreprises_ou_decidees    'heading cell M6
End With

On Error GoTo 2
'contact externe client is checked
If CheckBox1.Value = True Then
ActiveWorkbook.Worksheets(9).Select
test
End If
Exit Sub

2:
If CheckBox2.Value = True Then
ActiveWorkbook.Worksheets(8).Select
End If
End Sub
End If

Dit is de code die zoekt of de persoon al in de lijst staat of niet
Code:
Private Sub test()
    Dim ws As Worksheet
    Dim FindString As String
    Dim Rng As Range

    Set ws = ThisWorkbook.Worksheets(9)

    FindString = details_contacts.cmbbx_personne_de_contact_rencontrees.Value

    If Trim(FindString) <> "" Then
        Set Rng = ws.Cells.Find( _
                         What:=FindString, _
                         LookIn:=xlValues, _
                         LookAt:=xlWhole, _
                         SearchOrder:=xlByRows, _
                         SearchDirection:=xlNext, _
                         MatchCase:=False, _
                         SearchFormat:=False)

        If Not Rng Is Nothing Then
            Application.Goto Rng, True
            MsgBox ("person has been found in the list"), vbInformation
        Else
            MsgBox ("Nothing found" & _
                    vbNewLine & "I have already set the name in the list"), vbInformation
              Dim LastBlankRow As Long
        'Step 2:  Capture the last used row number.
        LastBlankRow = Cells(Rows.Count, 6).End(xlUp).Row + 1
        'Step 3:  Select the next row down
        Cells(LastBlankRow, 6).Select
        With ActiveCell
        .Value = details_contacts.cmbbx_personne_de_contact_rencontrees.Value                       'see userform2
        End With
        End If
    End If
test1
End Sub

dit is de code die ik heb voor de cell in te vullen
Code:
Sub test1()
'Dim mydate As Variant
Select Case True
Case "01"
If Mid(Me.DTPicker1.value, 4, 6) = "01" Then
ActiveCell.Offset(0, 1).Value = Format(details_contacts.DTPicker1.Value, "mm")

End If
End Sub
 
Misschien handig als je het bestandje er ook even bijdoet.
 
Zal het anders formuleren
Het bestand is te groot

Volgende foto geeft de userform weer
helpmij.jpg
Men vult alles in.

hij doet alles wat ik vraag
Hij vult de lijst in op de huidige sheet
Hij gaat naar sheet 2 om te kijken of persoon er al dan niet instaat en vult desnoods aan

Dan zou de computer naar de datum moeten kijken in de userform en sheet 2 op de huidige rij verder moeten aanvullen

Aangezien dat de maanden belangrijk zijn.
Kijkt de computer in de userform naar de waarde van de datum
vb: 12/02/2017 --> maand 02 in dit voorbeeld
computer moet dan de waarde van tekstvak naast po

dit is de code om dat resultaat te bereiken maar vult nu ook januari in terwijl dat niet de bedoeling is
Code:
Sub test1()
Dim mydate As Variant
mydate = Mid(Me.DTPicker1.Value, 3, 6)
If mydate = "/01/" Then GoTo 1
If mydate = "/02/" Then GoTo 2

1: ActiveCell.Offset(0, 1).Value = Me.txtbx_po
2: ActiveCell.Offset(0, 2).Value = Me.txtbx_po

End Sub
dit is het voorbeeld dat ik nu krijg
helpmij 2.jpg

dit is het resultaat dat ik nodig heb (waarde in userform naast datum is 17/02/2017)

helpmij3.jpg
 

Bijlagen

  • helpmij 2.png
    helpmij 2.png
    2,1 KB · Weergaven: 34
Kijk naar de maand van de datepicker.
Code:
mydate = month(DTPicker1)
If mydate = 1 Then GoTo 1
If mydate = 2 Then GoTo 2

of:
Code:
Goto month(dtpicker1)

Of zonder Goto:
Code:
ActiveCell.Offset(, month(dtPicker1) = Me.txtbx_po
 
Laatst bewerkt:
Het hele bestand is natuurlijk niet nodig. Even opslaan als. Alles wat niet relevant is eruit halen en dan hier plaatsen.
 
HSV

Hartelijk dank om dit op te lossen. Ze werkten allemaal :-)

VenA: Ik heb het geprobeerd om het kleiner te maken maar het was nog te groot :-) maar bedankt voor de tip
 
Een voorbeeldbestand is nooit te groot. Even opslaan als .xlsb dan mag je een groter bestand uploaden.

Los van de vraag volgens mij vlieg je hier al de bocht uit.
Code:
ThisWorkbook.Worksheets(6).Select

'find first empty cell counted from the buttom of column B
With ActiveWorkbook.Worksheets(4)
Range("B65536").End(xlUp).Offset(1, 0).Select
End With

Je haalt de laatste rij uit sheets(6) op en of dat de bedoeling is weet ik natuurlijk niet. En zo zitten er meerdere zaken in die verbeterd kunnen worden. Maar als het werkt dan werkt het.:d
 
Beste VenA

Wat betreft de codes weet ik ook dat er nog veel kan aan gewerkt worden, maar dat zijn zorgen voor later :-)
Dan ga ik mijn hoofd daar nog is over breken :-) als ze niet achter mij zitten van hoe ver sta je al en dergelijke :-)
Zal een geode leerschool zijn :-)

Kortom er Is nog voldoende ruimte voor mij om bij te leren :-)

Zoals je zei als het werkt werkt het.
 
hsv

is het mogelijk om met deze code als de de cell als is ingevuld hij de volgende cel neemt om een waarde in te vullen (heb dit over het hoofd gezien)

Hiermee bedoel ik iedere maand heeft 3 kolommen dus als er al (zie mai) staat er al iets in dan moet hij gewoon de volgende cel nemen

helpmij1.jpg

Code:
Sub test1()
Dim mydate As Variant
mydate = Month(DTPicker1)
If mydate = 1 Then GoTo 1
If mydate = 2 Then GoTo 2
If mydate = 3 Then GoTo 3
If mydate = 4 Then GoTo 4
If mydate = 5 Then GoTo 5
If mydate = 6 Then GoTo 6
If mydate = 7 Then GoTo 7
If mydate = 8 Then GoTo 8
If mydate = 9 Then GoTo 9
If mydate = 10 Then GoTo 10
If mydate = 11 Then GoTo 11
If mydate = 12 Then GoTo 12

1: ActiveCell.Offset(0, 1).Value = Me.txtbx_po
Exit Sub
2: ActiveCell.Offset(0, 4).Value = Me.txtbx_po
Exit Sub
3: ActiveCell.Offset(0, 7).Value = Me.txtbx_po
Exit Sub
4: ActiveCell.Offset(0, 10).Value = Me.txtbx_po
Exit Sub
5: ActiveCell.Offset(0, 13).Value = Me.txtbx_po
Exit Sub
6: ActiveCell.Offset(0, 16).Value = Me.txtbx_po
Exit Sub
7: ActiveCell.Offset(0, 19).Value = Me.txtbx_po
Exit Sub
8: ActiveCell.Offset(0, 22).Value = Me.txtbx_po
Exit Sub
9: ActiveCell.Offset(0, 25).Value = Me.txtbx_po
Exit Sub
10: ActiveCell.Offset(0, 28).Value = Me.txtbx_po
Exit Sub
11: ActiveCell.Offset(0, 31).Value = Me.txtbx_po
Exit Sub
12: ActiveCell.Offset(0, 33).Value = Me.txtbx_po
Exit Sub
End Sub
 
Plaats een .xlsb bestand.
Waarom verspringt alles 3 cellen en de laatste (12) maar 2?

Edit: Laat maar, de dtpicker zal ik waarschijnlijk niet hebben.
 
Laatst bewerkt:
Kan je hiermee leven?
Code:
Sub test1()
activecell.offset(, month(dtpicker) * 3 + iif(activecell.offset(, month(dtpicker) * 3 - 2) <> "", 1,0) - 2) = [COLOR=#3E3E3E]txtbx_po
End sub
[/COLOR]
 
HSV

Heb u code getest maar hij gaat niet naar de maand van dtpicker en ook niet bij de 3de keer je iets invult in dezelfde maand via het userform.
 
Klopt, hij gaat naar de cel afhankelijk van de maand van de dtpicker.

activecell=kolom(A)........offset(maand(3)*3-2) = kolom(H).
 
Heb het nog is nagekeken en hij zet de waarde telkens in kolom AM en als je nog is klikt AN met dezelfde maand

Verander je de maand in de userform zet hij deze ook zoals hierboven vermeld in de kolommen
 
Het ligt er wel aan in welk kolom je een cel hebt geselecteerd (Activecell).
 
heb er vandaag nog is mee aan de slag gegaan en u formule ontleed op een nieuw werkblad

Het klopt maar echter wil hij dit niet uitwerken in het bestand
 
Ik heb helaas die dtpicker niet.

Creëer eens een code waarmee de datepicker iets in een cel zet, en zet het resultaat hier eens neer.
Als het een datum is, zal month moeten werken.
Misschien moet je even kijken naar 06-05-2017 en 05-06-2017; of die goed worden overgenomen naar de cel.
Anders:
Code:
range("a1") = [COLOR=#0000ff]cdate([/COLOR]dtpicker[COLOR=#0000ff])[/COLOR]
gebruiken.
 
heb gedaan zoals je gevraagd hebt

dit is de code
Code:
Private Sub CommandButton10_Click()
ActiveCell.Offset(0, 3).Value = Me.DTPicker1.Value
End Sub

dit is het resultaat links in de lijst rechts deel van de userform
helpmij.jpg
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan