Enregistrements successifs sur une même ligne!

[Provence Vintage]

Bonjour Aux Forumeurs Excelliens,

Je croyais pouvoir me lancer tout seul dans une nouvelle aventure, ;-(
apparement c loupé. . .!


Pour les plus rapides:

Via un USF J'enregistre sur une ligne de feuille, des données;
comment en fonction d'un label de cet USF dont la valeur serait présente en colonne A, reprendre l'enregistrement sur cette même ligne!?

Pour Plus de détails:

J'ai construit un USF qui se veut être un calendrier:

l'affichage est une période mensuelle,
les enregistrements fonctionnent Mois par mois,
La date et le jour de début de chaque période mensuelle sont prédéfinis en fonction d'un USF d'initialisation de ce calendrier,
Sur chaque date, on peut spécifier un évenement, en fonction duquel la date change de couleur;

Pas de problème pour enregistrer mes périodes mensuelles dans ma feuille "Calendriers",

par contre;

je n'arrive pas à:

Un exemple,

USF initialisation
s'affiche janvier 2009 déjà chécké!
disponible en création: les autres mois
sélection Fevrier!
USF Calendrier apparait!
Fevrier en Caption et année 2009!
là tout est ok
enregistrement des dates et des jours dans calendrier, ok!
Mais comment dans une autre feuille nommée "CalendriersCheckés"
enregistrer Fevrier sur la même ligne que celle déjà utilisée (2009, janvier)

Voici la formule, ainsi que le fichier pour les courageux(ses)

#Private Sub BtnVal_Click()
Dim lVal As Long
Dim aVal As Long
lVal = Sheets("Calendriers").Range("A65000").End(xlUp).Row + 1
aVal = Sheets("CalendriersCheckés").Range("A65000").End(xlUp).Row + 1
xVal = Sheets("CalendriersCheckés").Range("A65000").End(xlUp).Row + 1
TransfertFeuille (lVal)

' c à partir de là que....

IniCtlCalendriersCheckés (LMod)
TransfertFeuilleChecké (aVal)
SuiteTransfertFeuilleChecké (xVal)
TrierBaseCalendriersCheckés
End Sub#

#Sub IniCtlCalendriersCheckés(a As Long)
With Sheets("CalendriersCheckés")
ControleAnnéeCheckée = ""
ControleAnnéeCheckée = .Cells(a, 1)
End With

End Sub#


#Sub TransfertFeuilleChecké(b As Long)
With Sheets("CalendriersCheckés")
.Cells(b, 1) = AnnéeNum.Caption
If Mois.Caption = "Janvier" Then
.Cells(b, 2) = Mois.Caption
.Cells(b, 14) = NomPremierJour.Caption
End If
End With
End Sub#

#Sub SuiteTransfertFeuilleChécké(b As Long)
If AnnéeNum.Caption = ControleAnnéeCheckée.Caption Then
.Cells(b, 1) = AnnéeNum.Caption
If Mois.Caption = "Fevrier" Then
.Cells(b, 3) = Mois.Caption
End If
If Mois.Caption = "Mars" Then
.Cells(b, 4) = Mois.Caption
End If
If Mois.Caption = "Avril" Then
.Cells(b, 5) = Mois.Caption
End If
If Mois.Caption = "Mai" Then
.Cells(b, 6) = Mois.Caption
End If
If Mois.Caption = "Juin" Then
.Cells(b, 7) = Mois.Caption
End If
If Mois.Caption = "Juillet" Then
.Cells(b, 8) = Mois.Caption
End If
If Mois.Caption = "Août" Then
.Cells(b, 9) = Mois.Caption
End If
If Mois.Caption = "Septembre" Then
.Cells(b, 10) = Mois.Caption
End If
If Mois.Caption = "Octobre" Then
.Cells(b, 11) = Mois.Caption
End If
If Mois.Caption = "Novembre" Then
.Cells(b, 12) = Mois.Caption
End If
If Mois.Caption = "Décembre" Then
.Cells(b, 13) = Mois.Caption
End If
End If
End With
End Sub#


Sans trop critiquer mes codes,
quelqu'un veut'il bien me venir en aide????


Merci d'avance à toutes et à tous

ci-joint fichier!
Bonne soirée

a+

Cijoint.fr - Service gratuit de dépôt de fichiers

 

[Provence Vintage]

Re : Enregistrements successifs sur une même ligne!

Oups, un p'tit coup de yop de bon matin!

Bonjour à toutes et tous!
y a ti quelqu'un qui aurait un brin d'idée!
ça s'rait gentil ça!
a toute

 

[Bebere]

Re : Enregistrements successifs sur une même ligne!

bonjour Provence Vintage
un peu de patience,laisse le temps de digérer
pour année bissextile ajout d'une fonction(fait)
ajouté constante pour les couleurs,simplifie le code
questions
dans feuille calendriers tu as année date mois jour
pour 1/1/2009 jour=lundi,alors que c'est jeudi
si à la place tu mets =b2 et tu formates date personnalisé "jjjj" tu as le jour officiel
pour les checkbox ,si seulement une des 3 peut être à true
une frame avec 3 optionbutton simplifie le code
si un essai avec module de classe t'intéresse je le fais
à bientôt

 

[Provence Vintage]

Re : Enregistrements successifs sur une même ligne!

Bebere, le Fil,

#questions
dans feuille calendriers tu as année date mois jour
pour 1/1/2009 jour=lundi,alors que c'est jeudi
si à la place tu mets =b2 et tu formates date personnalisé "jjjj" tu as le jour officiel
pour les checkbox ,si seulement une des 3 peut être à true
une frame avec 3 optionbutton simplifie le code
si un essai avec module de classe t'intéresse je le fais
à bientôt #

Explications

pour 2009, ce n'est qu'un essai d'enregistrement,
à partir du moment ou tu as déterminé qu'elle est le premier jour de l'année, le reste découle, même si bissextile!

pour les checkBox, j'avais essayé de simplifier, mais, lorsque l'on cliquait dans un Frame, les autres Text à l'intérieur changeaient également!:-(
c pour celà que j'ai codé un par un!
bien entendu je suis sur que l'on peut simplifier!

Par contre, avant de tout remodeler + simple, j'ai besoin de solutionner mon enregistrement sur une ligne (pour avancer sur d'autres USF),

dans l'exemple:
année 2009 sur l'USF, janvier et fevrier déjà chécké;
nous sommes donc sur la création de Mars,
j'ai besoin que Mars aille s'enregistrer sur la ligne 2009 dans la feuille "Calendriers Checkés", en colonne d.

Merci à toutes et tous

 

[Provence Vintage]

Re : Enregistrements successifs sur une même ligne!

Re le Fil,

Rahhhhhhh, j'ai essayé comme ceci:

#Sub TransfertFeuilleCalendriersCheckés()
With Worksheets("CalendriersCheckés")
If b > 0 Then
.Cells(b, 1) = ControleAnnéeCheckée.Caption
.Cells(b, 2) = Janvier.Caption
.Cells(b, 3) = Fevrier.Caption
.Cells(b, 4) = Mars.Caption
.Cells(b, 5) = Avril.Caption
.Cells(b, 6) = Mai.Caption
.Cells(b, 7) = Juin.Caption
.Cells(b, 8) = Juillet.Caption
.Cells(b, 9) = Août.Caption
.Cells(b, 10) = Septembre.Caption
.Cells(b, 11) = Octobre.Caption
.Cells(b, 12) = Novembre.Caption
.Cells(b, 13) = Décembre.Caption
End If
End With
End Sub#

Avec en Option Explicit
Dim b As Long

Mais rien à faire,
Qui peut m'aider à coder pour enregistrer les autres mois chéckés sur ma ligne déjà éxistante?!

Merci

 

[ChTi160]

Re : Enregistrements successifs sur une même ligne!

Salut Provence Vintage
bonjour le fil
Ta variable b n'a pas de valeur (apparemment)
exemple mets b = 3 --->pour la ligne 3
pourquoi If b > 0 comme test ?
tu pourrais mettre

'si le control ControleAnnéeCheckée est visible donc check alors on remplie la cellule de sa valeur de caption , sinon vide
.Cells(b, 1) = IIf(ControleAnnéeCheckée.visible=true ,ControleAnnéeCheckée.Caption,"")
'Idem ci dessous
.Cells(b, 2) = IIf(Janvier.visible=True,Janvier.Caption,"")
etc

Bonne continuation

 

[Bebere]

Re : Enregistrements successifs sur une même ligne!

bonjour Jean Marie
Pinot vintage
j'ai testé cela ,bouton enregistrer
est ce ce que tu veux


Private Sub BtnVal_Click()
Dim lVal As Long, Cel As Range, C As Long, L As Long
Dim aVal As Long
Dim xVal As Long

lVal = Sheets("Calendriers").Range("A65000").End(xlUp).Row + 1
aVal = Sheets("CalendriersCheckés").Range("A65000").End(xlUp).Row + 1
xVal = Sheets("CalendriersCheckés").Range("A65000").End(xlUp).Row + 1

With Sheets("CalendriersCheckés")
Set Cel = .Columns(1).Find(CDbl(Me.AnnéeNum))
If Not Cel Is Nothing Then L = Cel.Row
C = .Cells(L, 1).End(xlToRight).Column + 1
.Cells(L, C) = Mois.Caption
End With

TransfertFeuille (lVal)
IniCtlCalendriersCheckés (LMod)
TransfertFeuilleChecké (aVal)

TrierBaseCalendriersCheckés
End Sub

à bientôt

 

[Bebere]

Re : Enregistrements successifs sur une même ligne!

bonjour Provence Vintage,Jean Marie
Cijoint.fr - Service gratuit de dépôt de fichiers
quelques changements effectués
l'erreur était set r ensuite l=cel.row(devait être l=r.row)
ne t'étonne pas que rien ne s'affiche dans le 2ème userform
le code de PremierJourDuMois n'est pas fini
besoin d'explication
à bientôt

 

[Provence Vintage]

Re : Enregistrements successifs sur une même ligne!

Jean-Marie, Bebere,

Bonjour à vous deux, merci pour ce bon bout d'explications et d'améliorations de code;

de mon côté, j'avais fini par trouver une solution "archaïque" à la modif de ma ligne:

j'ai changé le bouton valide:
#Private Sub BtnVal_Click()
Dim lVal As Long
Dim aVal As Long
lVal = Sheets("Calendriers").Range("A65000").End(xlUp).Row + 1
TestRemplissage
TestTransfert
TransfertFeuille (lVal)
End Sub#

en déclarations:
#Option Explicit
Dim L As Long
Dim b As Long
Dim PalVert&
Dim PalRouge&
Dim PalNoir&
Dim PalBleue&#

En Initialize: (j'ai rajouté le test)
#TestAnCheck#

#Sub TestAnCheck()
Dim Cel As Range
Dim L
Worksheets("CalendriersCheckés").Activate
Set Cel = Range("A1")
Set Cel = Columns(1).Find(What:=AnnéeNum.Caption, After:=Cel, _
LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not Cel Is Nothing Then
L = Cel.Row
ControleAnnéeCheckée.Caption = Cells(L, "A")
Janvier.Caption = Cells(L, "B")
Fevrier.Caption = Cells(L, "C")
Mars.Caption = Cells(L, "D")
Avril.Caption = Cells(L, "E")
Mai.Caption = Cells(L, "F")
Juin.Caption = Cells(L, "G")
Juillet.Caption = Cells(L, "H")
Août.Caption = Cells(L, "I")
Septembre.Caption = Cells(L, "J")
Octobre.Caption = Cells(L, "K")
Novembre.Caption = Cells(L, "L")
Décembre.Caption = Cells(L, "M")
Else
End If
End Sub#

le test "remplissage":

#Sub TestRemplissage()
If Fevrier.Caption = "" Then
If Mois.Caption = "Fevrier" Then
Fevrier.Caption = "Fevrier"
Else
Exit Sub
End If
End If
If Mars.Caption = "" Then
If Mois.Caption = "Mars" Then
Mars.Caption = "Mars"
Else
Exit Sub
End If
End If . . . . .#

Avec des labels sur mon USF!

le test transfert (qui me permet si c'est une nouvelle année, mois de janvier, un enregistrement différent, si une année en cours, une modif de la ligne!)
oui je sais, c chadoc ;-(

#Sub TestTransfert()
Dim aVal As Long
aVal = Sheets("CalendriersCheckés").Range("A65000").End(xlUp).Row + 1
If Janvier.Caption = "" Then
TransfertFeuilleChecké (aVal)
Else
TransfertFeuilleCalendriersCheckés
End If
End Sub#

et enfin la modif:
#Sub TransfertFeuilleCalendriersCheckés()
Dim Cel As Range
Set Cel = Sheets("CalendriersCheckés").Columns(1).Find(AnnéeNum, LookIn:=xlValues, lookat:=xlWhole)
If Cel Is Nothing Then Exit Sub 'GoTo erreur
With Cel

.Cells(L + 1, "C") = Fevrier.Caption
.Cells(L + 1, "D") = Mars.Caption
.Cells(L + 1, "E") = Avril.Caption
.Cells(L + 1, "F") = Mai.Caption
.Cells(L + 1, "G") = Juin.Caption
.Cells(L + 1, "H") = Juillet.Caption
.Cells(L + 1, "I") = Août.Caption
.Cells(L + 1, "J") = Septembre.Caption
.Cells(L + 1, "K") = Octobre.Caption
.Cells(L + 1, "L") = Novembre.Caption
.Cells(L + 1, "M") = Décembre.Caption
End With
TrierBaseCalendriersCheckés
End Sub#

En ce qui concerne les modifs de bebère:

j'ai un bug ici: (rouge)

#Private Sub BtnVal_Click()
Dim lVal As Long, Cel As Range, C As Long, L As Long
Dim aVal As Long
Dim xVal As Long
lVal = Sheets("Calendriers").Range("A65000").End(xlUp).Row + 1
aVal = Sheets("CalendriersCheckés").Range("A65000").End(xlUp).Row + 1
xVal = Sheets("CalendriersCheckés").Range("A65000").End(xlUp).Row + 1

With Sheets("CalendriersCheckés")
Set Cel = .Columns(1).Find(CDbl(Me.AnnéeNum))
If Not Cel Is Nothing Then L = Cel.Row
C = .Cells(L, 1).End(xlToRight).Column + 1
.Cells(L, C) = Mois.Caption
End With
TransfertFeuille (lVal)
IniCtlCalendriersCheckés (LMod)
TransfertFeuilleChecké (aVal)
TrierBaseCalendriersCheckés
End Sub#

Pour le code de "PremierJourDuMois":

toujours trés "Chadoc":

je n'arrivait pas à faire de correspondance auto entre une date et le jour qui lui incombe, donc:

en fonction du choix du premier jour de l'année,
dans feuille liste est calculé Mois Par Mois le premier jour des autres Mois

l'affichage me donne ensuite, par exemple:
pour 2009, si fevrier:
date en colonne fevrier: 01/02/2009

si premier jour de l'année est Lundi,
colonne février, correspondance: Jeudi
si Mardi, correspondance: Vendredi

. . . & So on pour chaque mois, glups

Pour l'instant, j'essaye de capter comment ton code me check bissextile en auto!!! ;-)

Merci bcp et à plus tard sur le fil
bonne journée

 

[Paritec]

Re : Enregistrements successifs sur une même ligne!

Bonjour Provence JM Bebere,
Provence, c'est dommage que tu ne sais pas utiliser les balises de code!!!!
les # au dessus dans la barre d'outils
bonne journée
a+
papou

 

[ChTi160]

Re : Enregistrements successifs sur une même ligne!

Salut
Pour détecter ou coller la nouvelle donnée
peut être en faisant le chemin inverse
tu as

C = .Cells (L, 1).End(xlToRight).Column + 1

Recherche en partant de la première colonne , attention si vide entre colonne 1 et les autres

mettre pour éviter cela

C = .Cells (L, 255).End(xlToLeft).Column + 1

on part de la dernière colonne de la feuille sur la ligne L vers la Gauche et on ajoute 1 pour se positionner sur la cellule vide à coté de dernière Cellule non vide Lol
Bonne journée

 

[Bebere]

Re : Enregistrements successifs sur une même ligne!

bonjour Provence,Paritec,Jean Marie
voir module1 pour la fonction vbabissextile et combobox1_change
à bientôt

 

[Bebere]

Re : Enregistrements successifs sur une même ligne!

re
pour Private Sub BtnVal_Click()

With Sheets("CalendriersCheckés")
Set Cel = .Columns(1).Find(CDbl(Me.AnnéeNum))
If Not Cel Is Nothing Then 'année existe
L = Cel.Row
C = .Cells(L, 256).End(xlToLeft).Column + 1
.Cells(L, C) = Mois.Caption
Else 'nouvelle année
L = .Range("A65000").End(xlUp).Row + 1
.Cells(L, 1) = CDbl(Me.AnnéeNum)
C = .Cells(L, 256).End(xlToLeft).Column + 1
.Cells(L, C) = Mois.Caption
End If
End With

à bientôt

 

[Bebere]

Re : Enregistrements successifs sur une même ligne!

bonjour Provence,Chti,Paritec
Cijoint.fr - Service gratuit de dépôt de fichiers
quelques explications dans userform
à bientôt

 

[Provence Vintage]

Re : Enregistrements successifs sur une même ligne!

Bonjour Bebere, le fil,je décortique en ce moment ton code;deux bugs:si on prends l'exemple du mois avril 2009, le premier jour du mois indiqué est l mercredi; lorsque l'usf calendrier s'ouvre, le 01/04/2009 est un jeudi;je ne trouve pas où ça déconne;ensuite, sur enregistrement ça se bloque sur la ligne en rouge:#Private Sub BtnVal_Click()Dim lVal As Long, cel As Range, C As Long, L As LongDim aVal As LongDim xVal As LonglVal = Sheets("Calendriers").Range("A65000").End(xlUp).Row + 1xVal = Sheets("CalendriersCheckés").Range("A65000").End(xlUp).Row + 1With Sheets("CalendriersCheckés")Set cel = .Columns(1).Find(CDbl(Me.AnnéeNum))If Not cel Is Nothing Then 'année existeL = cel.RowC = .Cells(L, 256).End(xlToLeft).Column + 1#Merci à toibonne journée