Transfert de valeur d'une table a l'autre
Bonjour tout le monde
Avant d'exécuter la macro "Enregistrer Relevé" les fonctions sur le tableau "Hydrate de carbones"
Ce tableau a pourtant aucune connexion avec le reste (Enfin ne devrait pas en avoir) il permet simplement de faire des additions de HdC en cliquant sur les produits colonne "C"
La macro "Enregistrer Relevé" doit transférer dans la feuille Saisies les informations suivante:
Cela dans la ligne de la date du jour
Q6-7-8 R6-7-8 S6-7-8 respectivement dans la feuille du mois dans les colonnes D-E-F I-J-K N-O-P
U6 dans la feuille du courant dans la colonne U
V7 et V8 dans les colonnes S et T
W7 dans la colonne V
Effacer dans la feuille (Saisie) les cellules Q6 Q7 Q8 R6 R7 R8 S6 S7 S9 U6 V7 V8 W7
Afficher un message "Saisies OK"
J'ai mal ecrit
quand j'exécute la macro "Enregistrer Relevé" les fonctions sur le tableau "Hydrate de carbones" le fonctionnement de ce tableau ne fonctionne plus
Ce tableau a pourtant aucune connexion avec le reste (Enfin ne devrait pas en avoir) il permet simplement de faire des additions de HdC en cliquant sur les produits colonne "C"
Bonjour
J'ai un peu modifié ton code et ne constate rien d'anormal
Sub EnregistrerData()
Dim TabSaisie() As Variant
Dim Mois As String
Firstline = 2 'numéro de ligne du jour 1 de chaque mois dans les feuilles mensuelles
Application.EnableEvents = False 'on désactive les évènements
With Range("t_Saisie").ListObject 'avec la table "t_Saisie" de la feuille "Saisies"
TabSaisie = .DataBodyRange.Value 'on met toutes les données dans un tablo vba
End With
Mois = Format([jour], "mmmm") 'on récupère le mois
lig = Day([jour]) + Firstline 'on en déduit le numéro de ligne destination==> suppose que le 1er du mois est toujours en ligne 3 (d'où le +2)
'on vérifie que la feuille existe et on la créé si besoin
If Not FeuilleExiste(Mois) Then
Sheets("MoisVierge").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Mois
NbJour = Day(WorksheetFunction.EoMonth(DateSerial(Year(Now), Month([jour]), 1), 0))
.Range("B3") = DateSerial(Year(Now), Month([jour]), 1)
.Range("B3:T3").AutoFill Destination:=.Range("B3:T" & NbJour + Firstline)
End With
End If
With Sheets(Mois) 'avec la feuille du mois on place les données
For i = LBound(TabSaisie, 1) To UBound(TabSaisie, 1) 'pour chaque ligne du tableau
.Cells(lig, 4 + (i - 1) * 5) = TabSaisie(i, 3)
.Cells(lig, 5 + (i - 1) * 5) = TabSaisie(i, 4)
.Cells(lig, 6 + (i - 1) * 5) = TabSaisie(i, 5)
Next i
'on ajoute les repas (on présume ici que les 3 relevés sont pour le MEME jour
.Cells(lig, 19) = TabSaisie(UBound(TabSaisie, 1) - 1, 8)
.Cells(lig, 20) = TabSaisie(UBound(TabSaisie, 1), 8)
.Cells(lig, 21) = TabSaisie(LBound(TabSaisie, 1), 7)
End With
'on vide les données de la table "t_Saisie"
With Range("t_Saisie").ListObject
.ListColumns("G7").DataBodyRange.ClearContents
.ListColumns("Menu").DataBodyRange.ClearContents
.ListColumns("Poids").DataBodyRange.ClearContents
.ListColumns("Plat").DataBodyRange.ClearContents
.ListColumns("Commentaires").DataBodyRange.ClearContents
End With
Application.EnableEvents = True
End Sub
RE
Tu as du supprimer la Fonction FeuilleExiste située sous la Sub EnregistrerData
Merci effectivement j'avais écrasé
ça fonctionne SUPER
Bonne journée
J'ai encore un petit problème avec l'enregistrement
J'enregistre le matin ça fonctionne
Je remplis les données à midi et j'enregistre de nouveau et la ça m'efface les données du matin et ça enregistre les données de midi.
et je pense que ce sera la même chose pour le soir
RE
A aucun moment tu n'as décrit ton processus.
Ton tableau contient une ligne pour le matin, une pour le midi et l'autre pour le soir soit à priori une journée
Et dans ton 1er message tu mets "doit transférer dans la feuille Saisies les informations suivante, cela dans la ligne de la date du jour"
Donc rien n'indique qu'on le fait n fois par jour et ce qui doit se passer dans ce cas...
C'est peut-être clair dans ta tête mais absolument pas dans ta demande...
J'enregistre le matin à midi et le soir (enfin plusieurs fois par jour). Je pense qu'il ne faut rien effacer dans la feuille saisie avant l'enregistrement du soir.
RE
Et comment Excel sait que c'est le soir ?
Quand la troisieme saisie (souper) est faith
RE
Sauf si Excel reste ouvert et/ou qu'on crée un compteur de mise à jour, Excel ne soupant pas, il ne peut déterminer quand il est l'heure...
Je pense qu,I’ll faut pas effcer les donees saisies said apres la saisie des data du repas du soir
Et chaque fois ecraser les saisies dans la feuille du mois. Come ca on peu corridor tant qu,on Veut dans la journee
On peux effaced les zones dans la feuille saisie de falcon automatique quand la date du jour change
Je pense que la sealed solution est l.effacement de touted les variable de la zone de saisie strong effacee lots du changement de la date du journey
J'ai supprimé dans la macro "enregistrer data" l’effacement des données
J’aimerais
- Lors de l'ouverture de la feuille Saisie, vérifié si la date du jour est différente de la cellule "jour"
Si c’est le cas, exécuté l'effacement des colonnes Q S U V W des lignes 5/6/7
- Position saisie dans la cellule
Si plus grand que 24:00 et plus petit que 09.01, positionnements dans la cellule Q6
Si plus grand que 09:00 et plus petit que 14:01, positionnement dans la cellule Q7
Si plus grand que 14:00 et plus petit que 19:01, positionnement dans la cellule Q8
Bonjour
Le cellule nommée Jour contenant une formule qui renvoie la date du jour, ce sera toujours égal...
On peut éventuellement se baser sur la dernière remplie du mois (ce qui oblige à gérer le changement de mois) et sur l'heure
Mais si ce code se produit à l'ouverture du fichier il ne se déclenche pas sur un fichier déjà ouvert...
Ne serait-il pas plus simple de tester combien de cellules sont remplies en P6:P8 ?
Ou alors quand la Zone P8 est remplie et que l'on clique sur "enregistrer relevé"
seulement dans ces conditions, la macro "enregistrer relevé" est alors suivie de l'effacement des données Q S U V W 6-7-8
Est ce faisable ?
Plus personne. Dimmable
RE
Si on reprend le code de départ on ajoute une condition mais on aurait intérêt dans ce cas à aussi vider P6:P8
Sub EnregistrerData()
Dim TabSaisie() As Variant
Dim Mois As String
Firstline = 2 'numéro de ligne du jour 1 de chaque mois dans les feuilles mensuelles
Application.EnableEvents = False 'on désactive les évènements
With Range("t_Saisie").ListObject 'avec la table "t_Saisie" de la feuille "Saisies"
TabSaisie = .DataBodyRange.Value 'on met toutes les données dans un tablo vba
End With
Mois = Format([jour], "mmmm") 'on récupère le mois
lig = Day([jour]) + Firstline 'on en déduit le numéro de ligne destination==> suppose que le 1er du mois est toujours en ligne 3 (d'où le +2)
'on vérifie que la feuille existe et on la créé si besoin
If Not FeuilleExiste(Mois) Then
Sheets("MoisVierge").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Mois
NbJour = Day(WorksheetFunction.EoMonth(DateSerial(Year(Now), Month([jour]), 1), 0))
.Range("B3") = DateSerial(Year(Now), Month([jour]), 1)
.Range("B3:T3").AutoFill Destination:=.Range("B3:T" & NbJour + Firstline)
End With
End If
With Sheets(Mois) 'avec la feuille du mois on place les données
For i = LBound(TabSaisie, 1) To UBound(TabSaisie, 1) 'pour chaque ligne du tableau
.Cells(lig, 4 + (i - 1) * 5) = TabSaisie(i, 3)
.Cells(lig, 5 + (i - 1) * 5) = TabSaisie(i, 4)
.Cells(lig, 6 + (i - 1) * 5) = TabSaisie(i, 5)
Next i
'on ajoute les repas (on présume ici que les 3 relevés sont pour le MEME jour
.Cells(lig, 19) = TabSaisie(UBound(TabSaisie, 1) - 1, 8)
.Cells(lig, 20) = TabSaisie(UBound(TabSaisie, 1), 8)
.Cells(lig, 21) = TabSaisie(LBound(TabSaisie, 1), 7)
End With
'on vide les données de la table "t_Saisie"
if Worksheets(Saisies").Range.("P8")<>"" then
With Range("t_Saisie").ListObject
.ListColumns("G7").DataBodyRange.ClearContents
.ListColumns("Menu").DataBodyRange.ClearContents
.ListColumns("Poids").DataBodyRange.ClearContents
.ListColumns("Plat").DataBodyRange.ClearContents
.ListColumns("Commentaires").DataBodyRange.ClearContents
End With
End if
Application.EnableEvents = True
End Sub