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

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Raf88
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

Raf88

XLDnaute Nouveau
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
Cliquez pour agrandir...
 
Trier par date Trier par votes
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....
 
Vote positif 0 Vote négatif
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...
Cliquez pour agrandir...
C'est pas DTPicker qui te donne la bonne date, c'est sa conversion en date
Code: 
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 :
Code: 
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 :
Code: 
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
Code: 
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)
Code: 
' 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 :
Code: 
' 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 !
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

L
  • Question Question
XL 2016 Actualisation d'une query via VBA
Réponses
5
Affichages
483
job75
job75
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
216
patricktoulon
patricktoulon
G
  • Résolu(e)
Copie de données d'une feuille à une autre
Réponses
2
Affichages
568
gui22
G
B
  • Question Question
XL 2019 Dans une macro de démarrage de fichier masquer le code par des Astérix ou point
Réponses
3
Affichages
89
sylvanu
sylvanu
E
  • Résolu(e)
Microsoft 365 Convertir en -tete tableau en date
Réponses
14
Affichages
687
eric72
E
R
  • Question Question
XL 2019 Transpose et limiter nombre de valeur
Réponses
1
Affichages
343
Rabeto
R
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
403
Gégé-45550
Gégé-45550
Z
  • Question Question
Microsoft 365 Ajouter une étiquette de confidentialité via macro
Réponses
4
Affichages
2 K
onobyone
O
F
  • Question Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
422
Francky79
F
F
  • Question Question
Microsoft 365 Changement de fonctionnement d'une macro suite au passage à windows 10
Réponses
1
Affichages
494
francha62
F
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
C
  • Question Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
429
CathyLD
C
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
498
GClaire
G
I
  • Résolu(e)
Microsoft 365 VBA EXCEL Utilisation d'une variable avec données dans un tableau
Réponses
4
Affichages
901
mapomme
mapomme
L
  • Question Question
XL 2021 Comment utiliser la colonne d'une adresse en Private Sub - svp ?
Réponses
3
Affichages
475
vgendron
vgendron
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
595
M@xu3L
M
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
857
MickaeL_D
M
D
  • Question Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
708
crocrocro
C
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
S
  • Résolu(e)
Microsoft 365 Inscrire automatiquement la date du jour et bloquer les cellules
Réponses
4
Affichages
617
sebastien176
S
Retour