Appel UserForm par double clic

Bonjour,

J'ai un tableau ou je renseigne toutes mes heures travaillés avec plusieurs feuilles (ANNÉE, EMPLOI, KM, pour l'année 2017, pour l'année 2017, pour l'année 2018, ect....)
Dans la feuille "ANNÉE",

Dans la cellule A3 , je renseigne l'année que je souhaite visualiser.

Je voudrais savoir si il y a une macro qui pourrait m'ouvrir un UserForm quand je double-clic dans une cellule entre B7 à AF42 avec différents champs dont la date correspondant à la cellule ou il y a eu le double clic (année selon la cellule A3) plutot que de créer une macro par jour.

Je voudrais aussi savoir comment on fait pour que dans l'UserForm, si des champs sont déjà renseigner pour les afficher sur fond gris non modifiable, pour les modifier il faudra cliquer sur un bouton "MODIFIER" sinon laisser les champs modifiable (pour ceux modifiable) puis de reporter les valeurs dans la feuille de l'année renseigner et sur la ligne du jour renseigner.

Bonjour,

Voici un exemple de ce qui est possible. Au double-clic, on ouvre l'userform. On stocke la valeur de la ligne sur laquelle on a cliqué. Tous les contrôles de l'userform dont le nom contient "Auto" (exemple : TextBox_Auto_Année) ont leur valeur alimentée automatiquement en fonction de leur nom. Il faudra adapter bien entendu :

'MODULE USERFORM

private sub UserForm1_initialize()

dim ctrl as control

for each ctrl in Me.controls 'pour chaque controle de l'userform
    if ctrl.name like "*Auto*" then 'si le nom du controle contient "Auto" EXEMPLE !!!!
        if ctrl.name like "*Année" then 'si le nom du controle termine par année EXEMPLE !!!!
            ctrl = year(cells(irow, 1)) 'valeur = année de la cellule en colonne 1
        end if
        ctrl.locked = true 'on verrouille le ctrl
        ctrl.backcolor = rgb(128,128,128) 'ctrl colorié en gris
    end if
next ctrl

end sub

'MODULE FEUILLE ANNEE
Public irow%

private sub worksheet_beforedoubleclick(byval target as range, cancel as boolean)

if not intersect(target, range("B7:AF42")) is nothing then 'au double clic sur zone
    cancel = true 'annulation entrée dans cellule
    irow = target.row 'stocke la ligne de la cible
    UserForm1.show 'affiche UserForm1
end if

end sub    

Cdlt,

Merci 3GB pour le double clic, je souhaiterais aussi connaitre un code pour remplir les champs Date ( selon le jour ou à lieu le double clic, ex Lundi 01 Mai) et Année dans le formulaire. J’essayerais ensuite d'adapter les autres champs si les cellules sont renseigner.

Alors, pour la date, ce n'est pas le cas le plus simple. Voici un exemple en considérant que les 2 label correspondant sont renommés Label_Date et Label_Année :

'MODULE USERFORM

private sub UserForm1_initialize()

with Sheets("Année")
    Label_Date.caption = format(Dateserial(.[A3], .cells(irow, 1), .cells(6, icol)), "dddd mmmm")
    Label_Année.caption = .[A3]
end with

end sub

'MODULE FEUILLE ANNEE
Public irow%, icol%

private sub worksheet_beforedoubleclick(byval target as range, cancel as boolean)

if not intersect(target, range("B7:AF42")) is nothing then 'au double clic sur zone
    cancel = true 'annulation entrée dans cellule
    irow = target.row 'stocke la ligne de la cible
    icol = target.column 'stocke colonne
    UserForm1.show 'affiche UserForm1
end if

end sub

Si la date est renvoyée en anglais, essayez :

Label_Date.caption = application.text(Dateserial(.[A3], .cells(irow, 1), .cells(6, icol)), "dddd mmmm")

Ou encore :

datelabel = Dateserial(.[A3], .cells(irow, 1), .cells(6, icol))
Label_Date.caption = evaluate("TEXT(" & datelabel & ", """dddd mmmm""")"

Je n'ai jamais essayé donc je ne sais pas ce que ça peut donner.

Cdlt,

Bonjour, j'ai essayer les différentes options mais cela m'ouvre bien l'UserForm mais vide de toutes dates.

Bonjour,

Oui, j'ai fait des essais entre temps et en effet, ça n'a pas marché. Le problème c'est que je ne suis pas familiarisé avec les userforms. Je comprends tout le raisonnement logique mais certaines subtilités m'échappent, enfin il s'agit peut-être de ma version...

Pouvez-vous essayer ce code dans le module de la feuille Année :

Public irow%, icol%, ladate, jour$, mois$

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("B8:AF42")) Is Nothing Then '<<< ADAPTER REFERENCE ZONE DOUBLE CLIC
    Cancel = True
    irow = Target.Row 'ligne de la cellule double cliquée
    icol = Target.Column 'colonne double clic
    With Sheets("Année")
        ladate = DateSerial(.[A3], Application.RoundUp((irow - 7) / 3, 0), .Cells(6, icol)) 'date reconstituée
        jour = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")(Weekday(ladate, vbTuesday)) & " " & .Cells(6, icol) 'jour converti en français (format JJJJ JJ) à partir de la valeur numérique du jour
        mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Decembre")(Application.int((irow - 7) / 3) 'mois converti en français à partir du mois numérique
    End With
    With UserForm1
        .Label1.Caption = jour & " " & mois 'prend la jour et le mois au format jjjj jj mmmm
        '.Label2.Caption = .[A3] 'année (label2 ok ?)
        .Show 'afficher userform
    End With
End If

End Sub

L'idéal serait d'avoir ces lignes :

UserForm1.Label1.Caption = jour & " " & mois
'UserForm1.Label2.Caption = .[A3]

dans votre procédure userform1_initialize mais, je ne sais pas pourquoi, ça ne marche pas chez moi...

Il faudra peut-être adapter si vous avez renommé vos contrôles car, ici, j'ai mis ceux d'origine.

Cdlt,

J'ai modifier le code car quelques erreurs chez moi,

Public irow%, icol%, ladate, jour$, mois$

Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("B8:AF42")) Is Nothing Then '<<< ADAPTER REFERENCE ZONE DOUBLE CLIC
    Cancel = True
    irow = Target.Row 'ligne de la cellule double cliquée
    icol = Target.Column 'colonne double clic
    With Sheets("Année")
        ladate = DateSerial(.[A3], Application.RoundUp((irow - 7) / 3, 0), .Cells(6, icol)) 'date reconstituée
        jour = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")(Weekday(ladate, vbTuesday)) & " " & .Cells(6, icol) 'jour converti en français (format JJJJ JJ) à partir de la valeur numérique du jour
        mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")(Application.Int((irow - 7) / 3)) 'mois converti en français à partir du mois numérique
    End With

    With UserForm1
        '.TextBox_Date.Caption = jour & " " & mois 'prend la jour et le mois au format jjjj jj mmmm
        '.Label2.Caption = .[A3] 'année (label2 ok ?)
        .Show 'afficher userform
    End With
End If

End Sub

Cependant j'ai une l'erreur d’exécution n°438 (Propriété ou méthode non gérer par cet objet) qui apparaît lors au double clic avec la ligne si dessous surligner en jaune lorsque je clic sur "Débogage"

mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")(Application.Int((irow - 7) / 3)) 'mois converti en français à partir du mois numérique

Il faut juste ça :

mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")(Int((irow - 7) / 3)) 'mois converti en français à partir du mois numérique

et s'il s'agit de textbox à remplir, plutôt ça :

.TextBox_Date.value = jour & " " & mois

Cdlt,

Voici le code erreur que j'ai maintenant

Oui, cette fois, l'objet parent est Userform1 donc il mettre Sheets("Année").[A3].value

Encore un nouveau code erreur, moi de mon coté j'essaye des code qui reste néant grrr

Public irow%, icol%, ladate, jour$, mois$

Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("B8:AF42")) Is Nothing Then '<<< ADAPTER REFERENCE ZONE DOUBLE CLIC
    Cancel = True
    irow = Target.Row 'ligne de la cellule double cliquée
    icol = Target.Column 'colonne double clic
    With Sheets("Année")
        jour = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")(Weekday(ladate, vbTuesday)) & " " & .Cells(6, icol) 'jour converti en français (format JJJJ JJ) à partir de la valeur numérique du jour
        mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")(Int((irow - 7) / 3)) 'mois converti en français à partir du mois numériqueladate = DateSerial(.[A3], Application.RoundUp((irow - 7) / 3, 0), .Cells(6, icol)) 'date reconstituée

    End With

    With UserForm1
        .ComboBox1 = jour & " " & mois 'prend la jour et le mois au format jjjj jj mmmm
        .TextBox_Année = Sheets("Année").[A3].Value
        .Show 'afficher userform
    End With
End If

End Sub

J'ai trouver une partie du problème car maintenant je jour est systématiquement un samedi, j'ai oublier de préciser que les lignes 7, 10, 13, 16, 19, 22, 24, 28, 31, 34, 37 et 40 contiennent les date complète (ex : Mardi 18 Novembre 2020) dans la feuille "Année".

Après réflexion, il serais plus utile de pouvoir changer la date dans l'UserForm via un calendrier qui apparaît lorsqu'on clique sur la flèche du ComboBox de la date et de reprendre l'année et de l'afficher dans le TextBox_Année. (servira pour les noms de feuilles).

Pouvez-vous essayer comme ça ? Je ne suis pas certain qu'il soit utile d'avoir la date dans un combobox.

Public irow%, icol%, ladate, jour$, mois$

Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("B8:AF42")) Is Nothing Then '<<< ADAPTER REFERENCE ZONE DOUBLE CLIC
    Cancel = True
    irow = Target.Row 'ligne de la cellule double cliquée
    icol = Target.Column 'colonne double clic
    With Sheets("Année")
        ladate = DateSerial(.[A3], Application.RoundUp((irow - 7) / 3, 0), .Cells(6, icol)) 'date reconstituée
        jour = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")(Weekday(ladate, vbTuesday)) & " " & .Cells(6, icol) 'jour converti en français (format JJJJ JJ) à partir de la valeur numérique du jour
        mois = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")(Int((irow - 7) / 3)) 'mois converti en français à partir du mois numérique

    End With

    With UserForm1
        .Label1.caption = jour & " " & mois 'prend la jour et le mois au format jjjj jj mmmm
        .TextBox_Année = Sheets("Année").[A3].Value
        .Show 'afficher userform
    End With
End If

End Sub

Je ne sais pas vraiment ce qu'il vous faut mais le sujet de départ était l'ouverture de l'userform par double-clic. Donc j'imagine qu'il faut que la date sur l'userform corresponde à la date du clic, sinon, il n'y a plus grand intérêt...

Cdlt,

Merci cela fonctionne, avoir la date dans un ComboBox servira d'afficher un calendrier lorsqu'on cliquera sur la petite flèche qui descend afin de modifier la date si on se trompe de date sur le double-clic, et pour que cela fonctionne correctement il faudrait plutôt extraire l'année du ComboBox plutôt que dans la cellule A3 de la feuille "Année" pour la mettre dans la TextBox_Année (qui sera non modifiable et servira de nom de feuille où "ranger" les différents champs du formulaire si déjà créer si non en créer une).