Calendrier, décalage de date + effacer l'heure...

[Raf88]

Bonjour à tous,

J'ai monté dans un cadre professionnel une base de donnée me permettant de suivre mon activité en terme de charge de travail à la date.

Pour se faire, je demande à mes chefs d'équipe de remplir un formulaire que j'ai créer. Mon premier problème à résoudre à été la date.... certains saisissaient 19 juillet... d'autres 19/07 dautres encore 19.7... bref, 50 format de dates ingérables !!!

J'ai choisis (grace à votre aide) d'utiliser un calendrier (DTPicker).

Tout fonctionnait à peu près bien... sauf un point... le calendrier m'ajoute à la date, l'heure de saisie... impossible de l'enlever... j'ai dans un premier temps utiliser la colonne voisine avec la formule suivante : ( = arrondi(gauche(cellule;8);1) ) Ca fonctionnait pas trop mal... mais pas convainquant... j'aimerai une autre solution si vous aviez ;-)

Mon second problème, c'est que depuis hier... mon programme me saisi à la date demandé dans le DTPicker... la date +3jours....

Je n'ai pas réussi à vous joindre mon fichier, trop loursd même compressé... voilà parcontre le code qui me pose problème....
Si certains d'entre vous ont un peu de temps pour m'améliorer cela... ce serait super sympa... car là je galère ! (En plus de l'amélioration, les explications seront les biensvenues... j'aimerai aussi progresser ;-) )

Private Sub validation_Click()

Worksheets("calcul").Select
Range("d6").Value = CDate(DTPicker3)
Range("e6").Value = CDate(DTPicker4)
Range("O6").Value = DateAff

' je dois tester tous les champs avant importation dans le tableau
If prepanum = "" Then
MsgBox "Merci de renseigner le numéro de votre préparation "
erreur = 1
End If
If nbuo = "" Then
MsgBox "Merci de renseigner le nombre d'UO "
erreur = 1
End If

If erreur = 0 Then
Worksheets("calcul").Select
Range("b5").Select
ActiveCell.Offset(0, 0).Value = prepanum
ActiveCell.Offset(0, 7).Value = UO
ActiveCell.Offset(0, 8).Value = nbuo
ActiveCell.Offset(0, 14).Value = Affheure
ActiveCell.Offset(0, 11).Value = com
Range("B5").Select
Range("B5").TextToColumns Destination:=Range("B5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Call VALIDER

Worksheets("BDD").Select
Range("A3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Offset(0, 0).Value = NumOrdre
ActiveCell.Offset(0, 1).Value = prepanum
ActiveCell.Offset(0, 8).Value = nbuo
ActiveCell.Offset(0, 11).Value = com
ActiveCell.Offset(0, 14).Value = Affheure
'ActiveCell.Offset(0, 13).Value = Round(ActiveCell(0, 3).Value, 0)
'ActiveCell.Offset(0, 14).Value = Left(ActiveCell(0, 13).Value, 10)

'copier/coller du résultat du calcul du temps estimé.
Worksheets("calcul").Select
Range("k5").Select
Range("k5").Copy
Sheets("BDD").Select
Range("J3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 0).NumberFormat = "[h]:mm:ss;@"
'copier/coller de la date d'édition de la préparation
Worksheets("calcul").Select
Range("d5").Select
Range("d5").Copy
Sheets("BDD").Select
Range("c3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copier/coller de la date prévue d'expédition
Worksheets("calcul").Select
Range("e5").Select
Range("e5").Copy
Sheets("BDD").Select
Range("d3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copier/coller la date d'affrètement :
Worksheets("calcul").Select
Range("o5").Select
Range("o5").Copy
Sheets("BDD").Select
Range("n3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copier/coller du type d'UO
Worksheets("calcul").Select
Range("i5").Select
Range("i5").Copy
Sheets("BDD").Select
Range("h3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' copier/coller du type de préparation
Worksheets("calcul").Select
Range("C28").Select
Range("C28").Copy
Sheets("BDD").Select
Range("K3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Worksheets("BDD").Select
' Range("A3").Select
'While ActiveCell.Value <> ""
'ActiveCell.Offset(1, 0).Select
'Wend
ActiveCell.Offset(0, 14).Value = Left(ActiveCell(0, 4).Text, 8)

' Mise en forme en convertissant toutes les colonnes
Columns("A:A").Select
Columns("A:A").TextToColumns Destination:=Columns("A:A"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("b:b").Select
Columns("b:b").TextToColumns Destination:=Columns("b:b"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("c:c").Select
Columns("c:c").TextToColumns Destination:=Columns("c:c"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("d:d").Select
Columns("d:d").TextToColumns Destination:=Columns("d:d"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("e:e").Select
Columns("e:e").TextToColumns Destination:=Columns("e:e"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("f:f").Select
Columns("f:f").TextToColumns Destination:=Columns("f:f"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("g:g").Select
Columns("g:g").TextToColumns Destination:=Columns("g:g"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("h:h").Select
Columns("h:h").TextToColumns Destination:=Columns("h:h"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
' mise en forme du format date avec le mois en toutes lettres
Columns("C:C").Select
Selection.NumberFormat = "[$-40C]d mmmm yyyy;@"
Columns("D").Select
Selection.NumberFormat = "[$-40C]d mmmm yyyy;@"
Worksheets("calcul").Select
Range("B12").Select
ActiveCell.Offset(0, 0).Value = NumOrdre
ActiveCell.Offset(0, 1).Value = prepanum
ActiveCell.Offset(0, 0).Value = NumOrdre
End If

Worksheets("BDD").Select
Unload NPrepa
Visual.Show
End Sub

Private Sub CommandButton3_Click()

Unload NPrepa
prep.Show

End Sub

Private Sub CommandButton4_Click()

Unload NPrepa

End Sub

Private Sub UserForm_initialize()
'afficher le numéro chrono de préparation
Dim num As Integer
Dim delta As Long
Dim i As Byte

For i = 3 To 4
Controls("DTPicker" & i).Value = Now()
Next i

Worksheets("BDD").Select
Range("A3").Select
While ActiveCell.Value <> ""
If ActiveCell.Offset(0, 0).Value <> "" Then
'se positionne sur la dernière cellule et ajoute la valeur 1 à sa valeur)
num = num + 1
ActiveCell.Offset(1, 0).Select
End If
Wend
'Affiche le numéro de chrono dans la cellule de saisie.
Me.NumOrdre.Value = num
'Création de la combolist pour le N° de préparation
With Sheets("Préparation").Range("A4")
delta = .End(xlDown).Row - 1
prepanum.List = Range(.Offset(0), .Offset(delta)).Value
End With
UO.AddItem ("Palette")
UO.AddItem ("Sacs")
UO.AddItem ("Fûts")
UO.AddItem ("BigBag")
End Sub
Sub VALIDER()

MsgBox "la saisie a été prise en compte"
Unload NPrepa

End Sub


Private Sub Cancel_Click()
Dim Rep As Byte
Rep = MsgBox("Etes-vous sûr de vouloir fermer l'application en cours ?", _
vbYesNo + vbQuestion, "Annuler l'application en cours ?")
If Rep = vbNo Then
Exit Sub
End If
Me.Hide
End
End Sub
'----------------------------------------------------

Private Sub prepanum_Change()

If prepanum = "" Then
Exit Sub
Else
Call rechD1
Me.TextBox1.Value = Sheets("calcul").Range("C28").Text
Me.TextBox2.Value = Sheets("calcul").Range("d28").Text
Me.TextBox3.Value = Sheets("calcul").Range("e28").Text
Me.TextBox4.Value = Sheets("calcul").Range("f28").Text
Me.TextBox5.Value = Sheets("calcul").Range("g28").Text
End If

End Sub
Private Sub rechD1()

Dim tabdp(25, 8) As String
Dim x As Integer
Dim D2 As String
' nettoyage de l'onglet "calcul"
Call pical
Worksheets("calcul").Select
D2 = Range("B28").Value
Worksheets("préparation").Select
Range("A3").Select
'incrémentation de la ligne du tableau temporaire
While ActiveCell.Value <> ""
If ActiveCell.Offset(0, 0).Value = D2 Then
x = x + 1
tabdp(x, 1) = ActiveCell.Offset(0, 0).Text
tabdp(x, 2) = ActiveCell.Offset(0, 1).Text
tabdp(x, 3) = ActiveCell.Offset(0, 2).Text
tabdp(x, 4) = ActiveCell.Offset(0, 3).Text
tabdp(x, 5) = ActiveCell.Offset(0, 4).Text
tabdp(x, 6) = ActiveCell.Offset(0, 5).Text
tabdp(x, 7) = ActiveCell.Offset(0, 6).Text
tabdp(x, 8) = ActiveCell.Offset(0, 7).Text

End If
ActiveCell.Offset(1, 0).Select
Wend
'Création du tableau
Worksheets("calcul").Select
Range("b28").Select
For i = 1 To x
ActiveCell.Value = tabdp(i, 1)
ActiveCell.Offset(0, 1).Value = tabdp(i, 2)
ActiveCell.Offset(0, 2).Value = tabdp(i, 3)
ActiveCell.Offset(0, 3).Value = tabdp(i, 4)
ActiveCell.Offset(0, 4).Value = tabdp(i, 5)
ActiveCell.Offset(0, 5).Value = tabdp(i, 6)
ActiveCell.Offset(0, 6).Value = tabdp(i, 7)
ActiveCell.Offset(0, 7).Value = tabdp(i, 8)
ActiveCell.Offset(1, 0).Select
Next i
'Affichage du résultat
End Sub

Sub pical()
Worksheets("calcul").Select
Rows("28:28").Select
Rows("28:28").ClearContents
Range("B28").Select
ActiveCell.Offset(0, 0).Value = prepanum
End Sub

 

[Raf88]

Re : Calendrier, décalage de date + effacer l'heure...

Mon problème est sur ces lignes :

Range("d6").Value = CDate(DTPicker3)
Range("e6").Value = CDate(DTPicker4)

Ca fonctionne, mais j'ai l'heure qui apparait, et je n'en veux pas....

Je les ai modifié ainsi :

Range("d6").Value = Format (DTPicker3.value, "dd/mm/yy")
Range("e6").Value = Format (DTPicker4.value, "dd/mm/yy")

Alors là c'est la cata !!!
1/ D6 m'apparait sans la date... il s'agit de la date du jour que j'ai fixée dans mes paramètres de calendrier... donc pas de soucis, j'obtient le resultat attendu....
2/ E6 se transforme en la date saisie -6mois ou plus troisjour selon les cas... et j'ai 00:00:00 à la fin... je n'y comprends pas grand chose, puisque j'ai respecter la même formule pour les deux...

Encore une fois mon fichier est trop lours pour que je puisse vous l'envoyer....

 

[Gorfael]

Re : Calendrier, décalage de date + effacer l'heure...

Salut Raf88 et le forum
Bienvenue
Utilises les balises de code (# en mode avancé), ton poste n'en sera que plus lisible

puisque j'ai respecter la même formule pour les deux...

C'est pas DTPicker qui te donne la bonne date, c'est sa conversion en date

Range("d6").Value = Format (CDate(DTPicker3), "dd/mm/yy")
Range("e6").Value = Format (CDate(DTPicker4), "dd/mm/yy")

3 kilomètres de scroll pour passer d'un poste à l'autre, alors qu'avec les balises...
A+
Edit : jeté un œil sur ta macro, et le code serait plutôt du genre :

Range("d6") = CDate(DTPicker3)
Range("e6") = CDate(DTPicker4)
[D6:E6].FormatNumber = "dd/mm/yy"

Pas envie de me creuser la tête pour un code farci de Select/activecel, qui utilise plein d'envois en sous-programmes.
alors juste une pour montrer qu'on peut simplifier :

Sub pical()
Sheets("calcul").Select
Rows("28:28").ClearContents
Range("B28") = prepanum
Range("B28").Select
End Sub

code qui donne la première cellule vide

Range("d3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend

Moi je préfère Cells(Rows.count,"D").end(xlup) (ou Cells(3,"D").end(xldown) pour rester dans la demande initiale)

' copier/coller la date d'affrètement :
Worksheets("calcul").Select
Range("o5").Select
Range("o5").Copy
Sheets("BDD").Select
Range("n3").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

donne alors :

' copier/coller la date d'affrètement :
Worksheets("calcul").Range("o5").Copy
Sheets("BDD").Cells(Rows.Count, "N").End(xlUp).PasteSpecial Paste:=xlPasteValues

Pour le même résultat : copier O5 de la feuille "calcul" dans la première cellule vide derrière la dernière non vide de N de la feuille BDD

Petite remarque, pour une personne n'utilisant pas ton fichier :
BDD semble suggérer une base de donnée => l'important étant qu'un enregistrement est dispatché sur une ligne unique, suivant les colonnes. Or, tu recalcules la ligne à chaque inscription dans une colonne => si tu as une (ou plusieurs) vide, bonjour les résultats...

Re-Edit : petit rappel : on n'en a rien à faire des fichiers de travail. Pour apprendre à l'utiliser, il faut trop de temps, qu'on n'a pas envie de lui consacrer ! D'où une limite de taille qui suffit largement pour un fichier d'essai : une ou deux feuilles, une dizaine de lignes et uniquement le problème à résoudre !
Le but n'est pas qu'on résolve ton problème, mais qu'on t'explique comment tu peux le résoudre, en te fournissant les codes, formules et explications pour te le permettre !