Effectuer deux procédures doubleclic distinctes en une seule.

Créer une discussion
Répondre

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
piga25

piga25

XLDnaute Barbatruc
Bonjour,

Cela doit être assez simple, mais là je n'y arrive pas.
Comment faire pour associer 2procédures (doubleclic) en une seule.
Procédure 1
Lorsque je fais undouble clic en colonne A (Nom : ClicA), cela insert une ligne.
Procédure2
Lorsque je fais un double clic en colonne J (Nom: ClicJ), cela affiche "FAIT"et si de nouveau double clic cela efface "Fait".
Merci
VB: 
Private test As Boolean 'déclare la variable test
Option Explicit
------------------------------------------------------------------------------------------------------------------------------
'Code écrit et commenté par Robert
Private Sub Worksheet_BeforeDoubleClick1(ByVal Target As Range, Cancel As Boolean)
Dim pl As Range 'déclare la variable pl (PLage)
Dim col As Byte 'déclare la variable col (COLonne)
Dim tc As Byte 'déclare la variable tc (Target Colonne)
Set pl = Range("ClicJ") 'définit la plage pl
'si la sélection est multiple ou si test est vrai, sort de la procédure
If Selection.Cells.Count > 1 Or test = True Then Exit Sub
'si le double-clic a lieu ailleurs que dans la plage pl, sort de la procédure
If Application.Intersect(Target, pl) Is Nothing Then Exit Sub
Cancel = True 'annule le mode édition lié au double-clic
test = True 'définit la variable test
Target.Value = IIf(Target.Value = "Fait", "", "Fait") 'de'finit la valeur de la cellule double-cliquée ("x" si vide, vide si "x")
If Target.Value = "" Then 'condition : si la valeur de la cellule double-cliquée est vide
    test = False 'redéfinit la variable test
    Exit Sub 'soret de la procédure
End If 'fin de la condition
test = False 'redéfinit la variable test
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------------

' A partir d'un code écrit par JPN
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim I As Integer, Ligne As Long
If Target.Column <> 1 Then Exit Sub 'Si en dehors colonne 1 on sort de la procédure
I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion") ' Affichage d'une boite de dialogue
If I = vbCancel Then Exit Sub ' si clique sur non on sort de la procédure
Ligne = Target.Row + 1
Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Inscription texte et formule dans cellules spécifiées.
Cells(Ligne, 2) = "Ajout donnée"
Cells(Ligne, 3) = Now
Cells(Ligne, 8).Formula = "=IF(ISNUMBER(R[-1]C),R[-1]C&CHAR(97),SUBSTITUTE(R[-1]C,RIGHT(R[-1]C,1),CHAR(CODE(RIGHT(R[-1]C,1))+1)))"
Cells(Ligne, 9).Formula = "=IF(AND(RC[-3]="""",RC[-2]=""""),"""",IF(AND(RC[-3]+RC[-2]>0,RC[1]=""Fait""),""EFFECTUE"",IF(AND(RC[-3]+RC[-2]>NOW(),RC[-3]+RC[-2]<=NOW()+15/1440),""ALERTE"",IF(RC[-3]+RC[-2]>NOW()+15/1440,""CREE"",""""))))"
' Effacement des éventuelles données dans les cellules spécifiées.
Union(Cells(Ligne, 4), Cells(Ligne, 5), Cells(Ligne, 6), Cells(Ligne, 7)).ClearContents
Cancel = True
Target.Offset(1, 4).Select
End Sub
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
Re : Effectuer deux procédures doubleclic distinctes en une seule.

Bonjour piga25,

Voici comment combiner les 2 :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 Then 'Si en dehors colonne 1 on sort de la procédure
        Dim I As Integer, Ligne As Long
        I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion") ' Affichage d'une boite de dialogue
        If I = vbCancel Then Exit Sub ' si clique sur non on sort de la procédure
        Ligne = Target.Row + 1
        Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        'Inscription texte et formule dans cellules spécifiées.
        Cells(Ligne, 2) = "Ajout donnée"
        Cells(Ligne, 3) = Now
        Cells(Ligne, 8).Formula = "=IF(ISNUMBER(R[-1]C),R[-1]C&CHAR(97),SUBSTITUTE(R[-1]C,RIGHT(R[-1]C,1),CHAR(CODE(RIGHT(R[-1]C,1))+1)))"
        Cells(Ligne, 9).Formula = "=IF(AND(RC[-3]="""",RC[-2]=""""),"""",IF(AND(RC[-3]+RC[-2]>0,RC[1]=""Fait""),""EFFECTUE"",IF(AND(RC[-3]+RC[-2]>NOW(),RC[-3]+RC[-2]<=NOW()+15/1440),""ALERTE"",IF(RC[-3]+RC[-2]>NOW()+15/1440,""CREE"",""""))))"
        ' Effacement des éventuelles données dans les cellules spécifiées.
        Union(Cells(Ligne, 4), Cells(Ligne, 5), Cells(Ligne, 6), Cells(Ligne, 7)).ClearContents
        Cancel = True
        Target.Offset(1, 4).Select
    ElseIf Target.Column = 10 Then
        Dim pl As Range 'déclare la variable pl (PLage)
        Dim col As Byte 'déclare la variable col (COLonne)
        Dim tc As Byte 'déclare la variable tc (Target Colonne)
        Set pl = Range("ClicJ") 'définit la plage pl
        'si la sélection est multiple ou si test est vrai, sort de la procédure
        If Selection.Cells.Count > 1 Or test = True Then Exit Sub
        'si le double-clic a lieu ailleurs que dans la plage pl, sort de la procédure
        If Application.Intersect(Target, pl) Is Nothing Then Exit Sub
        Cancel = True 'annule le mode édition lié au double-clic
        test = True 'définit la variable test
        Target.Value = IIf(Target.Value = "Fait", "", "Fait") 'de'finit la valeur de la cellule double-cliquée ("x" si vide, vide si "x")
        If Target.Value = "" Then 'condition : si la valeur de la cellule double-cliquée est vide
            test = False 'redéfinit la variable test
            Exit Sub 'soret de la procédure
        End If 'fin de la condition
        test = False 'redéfinit la variable test
    End If
End Sub

A+
 
Vote positif 0 Vote négatif
Re : Effectuer deux procédures doubleclic distinctes en une seule.

salut

ou ainSi...
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim Ligne As Long
  If Target.Column = 10 Then
    Target.Value = IIf(Target.Value = "Fait", "", "Fait")
  Else
    If Target.Column <> 1 Then Exit Sub
    If MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion") = vbCancel Then Exit Sub
    Ligne = Target.Row + 1
    Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(Ligne, 2) = "Ajout donnée"
    Cells(Ligne, 3) = Now
    Cells(Ligne, 6) = Now
    Cells(Ligne, 7) = Hour(Now) & ":" & Minute(Now) & ":" & Second(Now)
    Cells(Ligne, 8).FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C&CHAR(97),SUBSTITUTE(R[-1]C,RIGHT(R[-1]C,1),CHAR(CODE(RIGHT(R[-1]C,1))+1)))"
    Cells(Ligne, 9).FormulaR1C1 = "=IF(AND(RC[-3]="""",RC[-2]=""""),"""",IF(AND(RC[-3]+RC[-2]>0,RC[1]=""Fait""),""EFFECTUE"",IF(AND(RC[-3]+RC[-2]>NOW(),RC[-3]+RC[-2]<=NOW()+15/1440),""ALERTE"",IF(RC[-3]+RC[-2]>NOW()+15/1440,""CREE"",""""))))"
    Range("D" & Ligne & ":E" & Ligne).ClearContents
    Target.Offset(1, 4).Select
  End If
  Cancel = True
End Sub
 
Vote positif 0 Vote négatif
Re : Effectuer deux procédures doubleclic distinctes en une seule.

Bonsoir,
Merci à vous Fred0o 🙂 et Si...🙂
Les deux codes fonctionnent bien dans mon appli.
Je me doutais bien que je devais commencer par un If mais après mes connaissances en VBA n'ont plus suivi.

Au plaisir de vous lire dans d'autres fils.
Cordialement.
 
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

C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
250
CortoXls
C
M
  • Question Question
XL 2021 macro VBA
Réponses
4
Affichages
147
ManuEven
M
Etoto
  • Résolu(e)
Microsoft 365 VBA Insertion du numéro de semaine de manière dynamique
Réponses
11
Affichages
269
Etoto
Etoto
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
198
sebastien176
S
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
99
KRUG WOO
K
M
  • Question Question
XL 2016 liste déroulante formulaire vba excel
2
Réponses
20
Affichages
227
fanch55
fanch55
lynyrd
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
599
AtTheOne
AtTheOne
M
  • Question Question
Microsoft 365 macro en fct de l'état d'une autre (boucle)
Réponses
3
Affichages
108
sylvanu
sylvanu
I
  • Résolu(e)
Microsoft 365 Copier-coller dans une plage avec des cellules masquées
Réponses
6
Affichages
215
sylvanu
sylvanu
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
375
Phil69970
Phil69970
S
  • Question Question
XL 2019 Modifications avec Combobox liées
Réponses
7
Affichages
235
Dranreb
Dranreb
G
  • Question Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
19
Affichages
1 K
GClaire
G
T
  • Résolu(e)
XL 2021 Incompatibilité de type avec un userform
2
Réponses
19
Affichages
821
Bernard38
Bernard38
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
92
sylvanu
sylvanu
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
434
job75
job75
A
  • Question Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
335
sylvanu
sylvanu
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
411
sebastien176
S
S
  • Résolu(e)
XL 2016 Comment faire ressortir la ligne sélectionnée dans un tableau
Réponses
2
Affichages
501
Stéphane_1
S
P
  • Question Question
XL 2021 Ajout/adaptation de code VBA sur feuille qui en contient déjà
Réponses
3
Affichages
92
Pierreavecunp
P
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
334
Gestionnaire_rh
G
Retour