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

Correcte datum

Status
Niet open voor verdere reacties.
B

Bas1980

Gebruiker
Lid geworden
15 dec 2013
Berichten
64
Hallo,

Hier was ik wederom weer eens :)
Het project waar ik mee bezig ben is al een heel eind op weg mede met de hulp van jullie! Nu heb ik de volgende vraag:

In een textbox op een userform vult men een datum in, in de vorm 05-01-2017
Deze datum moet vervolgens 1 op 1 in een sheet worden over genomen
Wanneer er op ok is geklikt op het userform dan zet deze de datum echter als 01-05-2017 weg

Met andere woorden, e.e.a is dan helaas omgedraaid.
In de betreffende sheet staan de celeigenschappen op datum met als notatie 1 januari 2017.

Hoe krijg ik de ingevoerde datum nu wel juist over zonder dat excel er een sort van engelse notatie van maakt?

Cdate werkt niet helaas.

Groetjes,

Bas
 
= cdate(textbox1) zou gewoon moeten werken.
 
Waar zet ik deze neer? Userform_initialize?

Hij pakte hem niet. Wanneer de datums worden over gezet gebruikt excel de code:

Code: 
ws.Cells(iRow, 7).Value = Me.Txtpoort.Value
 
In de commandbutton_click event of zo?
Code: 
ws.Cells(iRow, 7).Value = cdate(Txtpoort.Value)
 
Waar ik dat stukje code ook neer zet, hij blijft het verkeerd doen
 
Dan wordt het tijd om een bestandje te plaatsen.
 
ws.Cells(iRow, 7).Value = dateserial(year(Txtpoort.Value), month(Txtpoort.Value), day(Txtpoort.Value))
 
Er staat momenteel te veel gevoelige info in het bestand. Zal het morgen proberen leeg te halen.

Misschien heb je er zo even wat aan en kun je me helpen:

Code: 
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
If Trim(Me.Txtnaam.Value) = "" Then
Me.Txtnaam.SetFocus
MsgBox "Voer minimaal een naam van een medewerker in!", vbExclamation, "Invoer vereist!"
Exit Sub
End If
cName = Txtnaam
response = MsgBox("" & cName & " zal worden toegevoegd aan de database", vbOKCancel, "Medewerker toevoegen")
If response = vbCancel Then
Unload Me
Exit Sub
End If
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Personeel en cursussen")
'vindt laatst gebruikte cel, ga naar de volgende rij
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'Controleer of er een naam is ingevuld
If Trim(Me.Txtnaam.Value) = "" Then
Me.Txtnaam.SetFocus
MsgBox "Voer minimaal een naam van een medewerker in!", vbExclamation, "Invoer vereist!"
Exit Sub
End If
'Plaatst gegevens in de database
ws.Cells(iRow, 1).Value = Me.Txtnaam.Value
ws.Cells(iRow, 2).Value = Me.Txtfirma.Value
ws.Cells(iRow, 3).Value = Me.Txtcontact.Value
ws.Cells(iRow, 4).Value = Me.Txtmedicijn.Value
ws.Cells(iRow, 5).Value = Me.Txtbijzonderheden.Value
ws.Cells(iRow, 6).Value = Me.Txtpslnr.Value
ws.Cells(iRow, 7).Value = Me.Txtpoort.Value
ws.Cells(iRow, 8).Value = Me.Txtloc.Value
ws.Cells(iRow, 9).Value = Me.Txtkwik.Value
ws.Cells(iRow, 10).Value = Me.Txtvca.Value
ws.Cells(iRow, 11).Value = Me.Txtwerkvergunning.Value
ws.Cells(iRow, 12).Value = Me.Txtnogepa.Value
ws.Cells(iRow, 13).Value = Me.Txtlmra.Value
ws.Cells(iRow, 14).Value = Me.Txtlsr.Value
ws.Cells(iRow, 15).Value = Me.Txth2s.Value
ws.Cells(iRow, 16).Value = Me.Txtoverig.Value
'Verwijder gegevens van formulier
Me.Txtnaam.Value = ""
Me.Txtfirma.Value = ""
Me.Txtcontact.Value = ""
Me.Txtmedicijn.Value = ""
Me.Txtbijzonderheden.Value = ""
Me.Txtpslnr.Value = ""
Me.Txtpoort.Value = ""
Me.Txtloc.Value = ""
Me.Txtkwik.Value = ""
Me.Txtvca.Value = ""
Me.Txtwerkvergunning.Value = ""
Me.Txtlmra.Value = ""
Me.Txtnogepa.Value = ""
Me.Txtlsr.Value = ""
Me.Txth2s.Value = ""
Me.Txtoverig.Value = ""
'Geeft een bericht dat de persoon succesvol is toegoevoegd aan de database
MsgBox "" & cName & " is succesvol toegevoegd. De database is automatisch opgeslagen.", vbInformation, "Succesvol toegevoegd!"
'Op alfabetische volgorde zetten en opslaan'
ActiveWorkbook.Worksheets("Personeel en cursussen").AutoFilter.Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Personeel en cursussen").AutoFilter.Sort.SortFields. _
Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Personeel en cursussen").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Save
response = MsgBox("Wil je nog een medewerker toevoegen?", vbYesNo, "Medewerker toevoegen")
If response = vbNo Then
Unload Me
End If
End Sub
 
Met de code kan ik niets.
Als het weggeschreven wordt zoals jij het invoert, ben ik nieuwsgierig waaraan dat ligt.

Ik gebruik altijd 'cdate' bij datums van textboxen, en vind het vreemd dat het niet werkt bij jou.

Ik weet de invoer niet, maar zoals je omschrijft in je openingspost is dit gewoon 1-5-2016.
Dan zou cdate gewoon moeten werken.
 
misschien kun je wat met de volgende gegevens om op jouw project toe te passen.
ThisButton = Format(Date, "dd/mm/yy")
voor het wegschrijven gebruik ik o.a.
Range("j4").Value = ThisButton
Range("j4").Value = Format(Range("j4").Value, "dd/mm/yyyy")
 
Mijn idee. Helaas draait excel de datum bij weg schrijven om. Zal morgen even kijken of het lukt om de file online te zetten. Dank voor nu!
 
Ok.... mijn fout. Heldere licht dat ik ben. CDate werkt perfect!

Ik gebruikte:
Code: 
ws.Cells(iRow, 7).Value = Me.Txtpoort.Value
en probeerde
Code: 
CDate
hier tussen te plakken.

Nu is het geworden:
Code: 
ws.Cells(iRow, 7).Value = CDate(Txtpoort.Value)

Stom...... Maar alle credits voor Harry! Thanks!
 
Wederom even terug. Vandaag weer bezig met bovenstaande. CDate werkt perfect echter wanneer ik een tekstvak leeg laat (Welke werkt met CDate) krijg ik de melding dat de typen niet overeen komen. Ik mag dus met de optie CDate geen lege tekstvakken hebben die een datum moeten bevatten.

Hoe kan ik er voor zorgen dat een tekstvak , voorzien van CDate, toch leeg mag blijven?
 
Code: 
if isdate(textbox1) then [COLOR=#3E3E3E]ws.Cells(iRow, 7).Value = CDate(Txtpoort.Value)[/COLOR]
 
Een beetje jammer dat er geen voorbeeldbestandje bijzit.
Volgens mij is het geheel te reduceren tot zoiets

Code: 
Private Sub CommandButton1_Click()
  Application.ScreenUpdating = False
  If Trim(txtnaam.Value) = "" Then
    txtnaam.SetFocus
    MsgBox "Voer minimaal een naam van een medewerker in!", vbExclamation, "Invoer vereist!"
    Exit Sub
  End If
  
  If MsgBox(txtnaam & " zal worden toegevoegd aan de database", vbOKCancel, "Medewerker toevoegen") = vbCancel Then
    Unload Me
    Exit Sub
  End If
  
  With Sheets("Personeel en cursussen")
    If IsDate(txtpoort) Then c00 = CDate(txtpoort)
    .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 16) = Array(txtnaam, Txtfirma, Txtcontact, Txtmedicijn, Txtbijzonderheden, Txtpslnr, c00, Txtloc, Txtkwik, Txtvca, Txtwerkvergunning, Txtnogepa, Txtlmra, Txtlsr, Txth2s, Txtoverig)
    c01 = c01 & txtnaam & vbLf
    
    For Each c In Controls
      If TypeName(c) = "TextBox" Then c.Text = ""
    Next c
    If MsgBox("Wil je nog een medewerker toevoegen?", vbYesNo, "Medewerker toevoegen") = vbNo Then
      .Cells(1).CurrentRegion.Sort .[A1], , , , , , , True
      Unload Me
      ActiveWorkbook.Save
      MsgBox c01 & IIf(UBound(Split(c01, vbLf)) = 1, "is", "zijn") & " succesvol toegevoegd. De database is automatisch opgeslagen.", vbInformation, "Succesvol toegevoegd!"
     Else
      txtnaam.SetFocus
    End If
  End With
End Sub
 
Hallo,

Ik zal zo even kijken of ik een voorbeeld bestand kan plaatsen :)
Ondertussen zal ik je code eens proberen. Thanks voor je input!
 
In dit bestand iig niet. Heb je de werking getest? Het is hier geen maakvoormij.nl!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan