Copier auto double clic et selection

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Demouret
  • 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
D

Demouret

XLDnaute Junior
Bonjour le forum..

J'ai trouvé et très legerement bidouillé un code qui permets en double cliquant sur une cellule de copier son contenu et de le coller vers une autre cellule avec clic droit..
C'est excellent mais je voudrai savoir comment etendre la selection selon la valeur d'une cellule adjacente.
J'ai joins un petit fichier car pas simple à expliquer

S'il y avait une bonne ame dans le coin ;-)

Merci de votre aide
 

Pièces jointes

Trier par date Trier par votes
Re : Copier auto double clic et selection

Bonjour,

Remplacez votre code par le code suivant

Code: 
Dim Plage As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'au double clic
Dim R As Range
If Target.Value = "" Then Exit Sub
Cancel = True 'évite le mode édition lié au double-clic
Set R = Target.Offset(0, 1)
If R <> 1 And R <> 2 And R <> 3 Then
  Cancel = False
  Exit Sub
End If
Set Plage = Target.Resize(R, 3)
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 'au clic droit
If Plage Is Nothing Then Exit Sub
Cancel = True 'évite le menu contextuel lié au clic droit
Plage.Cut Destination:=Target
Set Plage = Nothing
End Sub

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

En fait ca marche et j'en suis très heureux mais je comprends pas comment il detecte les plages qu'ils doit copier en fonction du 1 , 2 ou 3 dans la offset(0,1)??
Ca vient de resize(R,3) ???
Si tu avait encore un peu de temps...

Bien à vous

Pierre
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Bonjour,

Voici quelques commentaires
Code: 
Set R = Target.Offset(0, 1)
la cellule sur la même ligne mais 1 colonne à droite de la Target
(Ex : si Target = C10 alors R = D10)

Code: 
If R <> 1 And R <> 2 And R <> 3 Then
  Cancel = False
  Exit Sub
End If
Set Plage = Target.Resize(R, 3)
si la valeur de R est 1 ou 2 ou 3 alors le nombre de lignes de Target (Plage)
est redimensionné selon la valeur de R (1 ou 2 ou 3)
et le nombre de colonnes est redimensionné 3 (constante de 3 colonnes)


Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Bonjour à tous,

Je fais une petite incursion dans ce fil car j'aimerais reprendre la macro événementielle de Demouret ci-dessous.

Code: 
Private val As String
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'au double clic
If Target.Value = "" Then Exit Sub
Cancel = True 'évite le mode édition lié au double-clic
val = Target.Value 'définit la variable val
Target.Value = "" 'vide la cellule double cliqué
 
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 'au clic droit
If val = "" Then Exit Sub 'si la variable val est vide, sport de la procédure
Cancel = True 'évite le menu contextuel lié au clic droit
Target.Value = val 'place la valeur de la variable val dans la cellule
End Sub
Dans ce code, quelle instruction doit-on rajouter pour inhiber le coller avec le clic droit.

J'aimerais que l'on ne puisse pas effectuer un 2ème "Coller" suite au 1er.

PMO2 réalise cette action dans le code qu'il propose mais je n'arrive pas à l'adapter à celui de Demouret 😱

Pouvez-vous m'aider ?

Cibleo
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Re bonjour à tous,

J'ai épuré le code de PMO2 et cela fonctionne, le voici tout simplement 🙂

Code: 
Option Explicit
Dim Plage As Range

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'au double clic
If Target.Value = "" Then Exit Sub
Cancel = True 'évite le mode édition lié au double-clic
Set Plage = ActiveCell
End Sub

Code: 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 'au clic droit
If Plage Is Nothing Then Exit Sub
Cancel = True 'évite le menu contextuel lié au clic droit
Plage.Cut Destination:=Target
Set Plage = Nothing
End Sub


Cibleo
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Bonjour à tous,
Bonjour PMO2,

Je reviens sur mon dernier post.

J'aimerais placé les 2 macros événementielles ci-dessus dans le ThisWorkbook.

Dans mon classeur, j'ai de nombreusses feuilles dont celles qui sont nommées avec un format date "dd mm yy" et j'aimerais que les macros ne s'appliquent qu'à celles ci.

Pouvez-vous m'aider ?

Cibleo
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Bonjour,

Essayez avec le code suivant à mettre dans la fenêtre de code de ThisWorkbook
Code: 
Dim Plage As Range

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'au double clic
  '/// ajout Pmo ///
If Not IsDate(Sh.Name) Then Exit Sub
If NoFormatDate_ddmmyy(Sh.Name) Then Exit Sub
  '/////////////////
If Target.Value = "" Then Exit Sub
Cancel = True 'évite le mode édition lié au double-clic
Set Plage = ActiveCell
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'au clic droit
  '/// ajout Pmo ///
If Not IsDate(Sh.Name) Then Exit Sub
If NoFormatDate_ddmmyy(Sh.Name) Then Exit Sub
  '/////////////////
If Plage Is Nothing Then Exit Sub
Cancel = True 'évite le menu contextuel lié au clic droit
Plage.Cut Destination:=Target
Set Plage = Nothing
End Sub

Private Function NoFormatDate_ddmmyy(SheetName As String) As Boolean
If CStr(SheetName) <> Format(SheetName, "dd mm yy") Then NoFormatDate_ddmmyy = True
End Function
Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Bonjour à tous,
Bonjour PMO2,

Dans les 2 macros événementielles, j'ai rajouté la ligne surlignée ci-dessous et c'est bon 🙄

Code: 
  '/// ajout Pmo ///
If Not IsDate(Sh.Name) Then Exit Sub
If NoFormatDate_ddmmyy(Sh.Name) Then Exit Sub
[B][COLOR=darkred]If Intersect(Target, Range("C4:M15")) Is Nothing Then Exit Sub[/COLOR][/B]
  '/////////////////

Mais je reviens pour compléter l'évènement SheetBeforeRightClick 😉

Cibleo
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Bonjour,

Pour limiter l'action à la plage "C4:M15"

Code: 
Const CHAMP_VALIDE As String = "C4:M15"

Dim Plage As Range

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'au double clic
  '/// ajout Pmo ///
Dim R As Range
Set R = Application.Intersect(Target, Range(CHAMP_VALIDE))
If R Is Nothing Then Exit Sub
If Not IsDate(Sh.Name) Then Exit Sub
If NoFormatDate_ddmmyy(Sh.Name) Then Exit Sub
  '/////////////////
If Target.Value = "" Then Exit Sub
Cancel = True 'évite le mode édition lié au double-clic
Set Plage = ActiveCell
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'au clic droit
  '/// ajout Pmo ///
Dim R As Range
Set R = Application.Intersect(Target, Range(CHAMP_VALIDE))
If R Is Nothing Then Exit Sub
If Not IsDate(Sh.Name) Then Exit Sub
If NoFormatDate_ddmmyy(Sh.Name) Then Exit Sub
  '/////////////////
If Plage Is Nothing Then Exit Sub
Cancel = True 'évite le menu contextuel lié au clic droit
Plage.Cut Destination:=Target
Set Plage = Nothing
End Sub

Private Function NoFormatDate_ddmmyy(SheetName As String) As Boolean
If CStr(SheetName) <> Format(SheetName, "dd mm yy") Then NoFormatDate_ddmmyy = True
End Function

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Bonjour PMO2,

Dans le "SheetBeforeRightClick", j'aimerais effectuer des tests comme dans ce bloc extrait d'une réponse de bqtr post 34 du fil ci-dessous.

https://www.excel-downloads.com/threads/alimenter-1-listbox.118752/

Code: 
.../...
If .Cells(lign, Col) <> "" Then
    If MsgBox("Plage horaire déjà prise, voulez-vous remplacer la course initiale de " & Me.ComboChauffeurs & " ? ", vbYesNo + vbExclamation, "Attention :") = vbYes Then
       For k = 0 To ListBox1.ListCount - 1
         Concat = Concat & ListBox1.List(k) & Chr(10)
       Next
         Cells(lign, Col) = Left(Concat, Len(Concat) - 1)
    Else
       If MsgBox("Après la course initiale ?" & Chr(10) & Chr(10) & Cells(lign, Col), vbYesNo + vbInformation, "Position :") = vbYes Then
         For k = 0 To ListBox1.ListCount - 1
           Concat = Concat & ListBox1.List(k) & Chr(10)
         Next
         Cells(lign, Col) = Cells(lign, Col) & Chr(10) & Chr(10) & Left(Concat, Len(Concat) - 1)
       Else
         For k = 0 To ListBox1.ListCount - 1
           Concat = Concat & ListBox1.List(k) & Chr(10)
         Next
         Cells(lign, Col) = Left(Concat, Len(Concat) - 1) & Chr(10) & Chr(10) & Cells(lign, Col)
       End If
    End If
  Else
    For k = 0 To ListBox1.ListCount - 1
      Concat = Concat & ListBox1.List(k) & Chr(10)
    Next
      Cells(lign, Col) = Left(Concat, Len(Concat) - 1)
  End If
.../...

Au moment du clic droit, si la cellule est remplie, j'aimerais soit remplacer son contenu, soit le compléter avec 2 choix : Avant ou Après.

Il faut que je décline l'exemple de bqtr ci-dessus à ma macro clic droit.

A+ et merci de ton aide Cibleo

PS : je n'ai pas eu le temps d'analyser ta nouvelle réponse.
 
Vote positif 0 Vote négatif
Re : Copier auto double clic et selection

Bonjour à tous,
Bonjour PMO2,

Je reviens avec un fichier, ce sera plus clair.
Dans le ThisWorkbook, j'ai placé le code de PMO2 auquel j'ai intégré 1 série de tests dans le SheetBeforeRightClick.

Ci-dessous, les 2 instructions surlignées en bleu et rouge sont à modifier.
J'illustre par l'exemple le résultat souhaité :

Feuille "01 10 09", double-cliquez sur C9 puis cliquez droit sur D9 qui est une cellule non vide.

- 1 premier message apparait :
Si oui, le "Coller" s'effectue (Instruction en vert)

Si non, 1 deuxième message apparait et 2 nouveaux cas se présentent :

-----> Si oui, je conserve le contenu initial de la cellule pointée mais y insère le "coller" avant. (Instruction en bleu)
-----> Si non, je conserve le contenu initial de la cellule pointée mais y insère le "coller" après. (Instruction en rouge)

Dans ces 2 derniers cas, j'aimerais aussi placer un interligne Chr(10) pour aérer le contenu de la cellule.
Code: 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'au clic droit
  '/// ajout Pmo ///
Dim R As Range
Set R = Application.Intersect(Target, Range(CHAMP_VALIDE))
If R Is Nothing Then Exit Sub
If Not IsDate(Sh.Name) Then Exit Sub
If NoFormatDate_ddmmyy(Sh.Name) Then Exit Sub
  '/////////////////
If Plage Is Nothing Then Exit Sub
Cancel = True 'évite le menu contextuel lié au clic droit
If ActiveCell <> "" Then
    If MsgBox("Plage horaire déjà prise, voulez-vous remplacer la course déjà saisie ? ", vbYesNo + vbExclamation, "Attention :") = vbYes Then
         [COLOR=darkgreen][B]Plage.Cut Destination:=Target[/B][/COLOR]
    Else
       If MsgBox("Voulez-vous la placer avant ?", vbYesNo + vbInformation, "Avant ou Après") = vbYes Then
         [B][COLOR=blue]Plage.Cut Destination:=Target[/COLOR][/B]
       Else
         [COLOR=red][B]Plage.Cut Destination:=Target[/B][/COLOR]
       End If
    End If
  Else
      [COLOR=darkgreen][B]Plage.Cut Destination:=Target[/B][/COLOR]
  End If
Set Plage = Nothing
End Sub

Je résume : lors du clic droit sur 1 cellule pleine, 3 choix peuvent s'opérer :

- "Coller" en remplaçant le contenu de la cellule pointée.
- Concaténer le "Coller" avant le contenu de la cellule pointée.
- Concaténer le "Coller" après le contenu de la cellule pointée.

Pouvez-vous m'aider, je vous en remercie.

Cibleo
 

Pièces jointes

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

P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
2 K
Pac41240
P
C
  • Résolu(e)
Microsoft 365 Copier-coller et création onglet avec Double clic
Réponses
3
Affichages
733
chrislam86
C
K
  • Résolu(e)
Microsoft 365 copier coller avec un double clic
Réponses
3
Affichages
1 K
AtTheOne
AtTheOne
T
  • Résolu(e)
XL 2010 VBA - Double clics pour copier du texte
Réponses
6
Affichages
812
tchi456
T
T
  • Question Question
XL 2016 Centrer image dans colonnes spécifiques par copier/coller d'une image existante + bouton unique afficher/masquer image + effacer images en bloc
Réponses
12
Affichages
908
Phil69970
Phil69970
N
  • Résolu(e)
Microsoft 365 Copier/coller par double clic
Réponses
4
Affichages
1 K
netparty
N
N
  • Question Question
XL 2016 Copier des lignes d'une feuille à l'autre sur une même Excel par double clique
Réponses
0
Affichages
1 K
Ned2
N
C
  • Question Question
XL 2016 Code VBA copier une valeur sur une plage de données dont les cellules de début et fin varient
Réponses
2
Affichages
4 K
CD38
C
M
  • Question Question
Microsoft 365 Tri de colonnes avec 3 critères, remplissage de lignes vides avec formule + ventilation vers autre onglet
Réponses
8
Affichages
2 K
marinehaye
M
sebbbbb
  • Question Question
XL 2010 Création et ajout d'onglets par bouton macro selon plusieurs critères
Réponses
3
Affichages
1 K
sebbbbb
sebbbbb
S
  • Question Question
XL 2013 [RESOLU] VBA - Ouvrir un fichier et une feuille spécifique selon des cellules du fichier source
2
Réponses
21
Affichages
9 K
Scoty
S
Usine à gaz
  • Question Question
XL 2016 coller un texte dans la barre de formule
2
Réponses
17
Affichages
3 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Question Question
XL 2013 affichage menu au clic droit (uniquement au clic droit)
Réponses
7
Affichages
1 K
Lone-wolf
Lone-wolf
ymanot
  • Question Question
copier coller certaines lignes par double clic
Réponses
0
Affichages
644
ymanot
ymanot
C
  • Question Question
Macro pour copier/coller par double click....
Réponses
6
Affichages
3 K
Christian0258
C
J
  • Question Question
VBA Extraire valeur cellule double clic et se rendre dans feuil2 valeur équivalente
Réponses
9
Affichages
4 K
Johan
J
E
  • Question Question
XL 2013 Macro pour ouverture auto classeur et insertion données.
Réponses
2
Affichages
744
elisium
E
E
  • Question Question
XL 2013 Macro pour ouverture automatique classeur et copier coller.
Réponses
0
Affichages
693
elisium
E
T
  • Question Question
Vba copier-coller dans cellule où je double clic?
Réponses
2
Affichages
892
tripalere
T
F
  • Question Question
[VBA] C/C sur double clic "conditionnel"
Réponses
1
Affichages
784
mapomme
mapomme
Retour