Copier auto double clic et selection

Demouret · 28 Mai 2009

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

PMO2 · 28 Mai 2009

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

Demouret · 28 Mai 2009

Re : Copier auto double clic et selection

Merci Patrick ...

c'est excellent ca marche nickel

J'ai encore du pain sur la planche au niveau du VBA....

Encore merci
Bonne soirée

Demouret · 28 Mai 2009

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

PMO2 · 29 Mai 2009

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

Demouret · 2 Juin 2009

Re : Copier auto double clic et selection

Merci à vous Patrick
C'est clair...

Bonne journée

cibleo · 18 Septembre 2009

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

cibleo · 18 Septembre 2009

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

cibleo · 24 Septembre 2009

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

PMO2 · 24 Septembre 2009

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

cibleo · 24 Septembre 2009

Re : Copier auto double clic et selection

Re PMO2,

Génial çà marche 🙂

Un petit plus, j'aimerais aussi limité la macro à une plage donnée "C4:M15".

Cibleo

cibleo · 25 Septembre 2009

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

PMO2 · 25 Septembre 2009

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

cibleo · 25 Septembre 2009

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.

cibleo · 2 Octobre 2009

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

Copier auto double clic et selection

Demouret

XLDnaute Junior

Pièces jointes

PMO2

XLDnaute Accro

Demouret

XLDnaute Junior

Demouret

XLDnaute Junior

PMO2

XLDnaute Accro

Demouret

XLDnaute Junior

cibleo

XLDnaute Impliqué

cibleo

XLDnaute Impliqué

cibleo

XLDnaute Impliqué

PMO2

XLDnaute Accro

cibleo

XLDnaute Impliqué

cibleo

XLDnaute Impliqué

PMO2

XLDnaute Accro

cibleo

XLDnaute Impliqué

cibleo

XLDnaute Impliqué

Pièces jointes

Discussions similaires

Copier auto double clic et selection

XLDnaute Junior

Pièces jointes

XLDnaute Accro

XLDnaute Junior

XLDnaute Junior

XLDnaute Accro

XLDnaute Junior

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Accro

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Accro

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency