Modification de code pour click copie

[Kouks]

Bonjour tout le monde,

J'ai le code suivant qui me permet de cliquer sur une plage des cellules dont le contenue vient s'additionner dans une cellule total.

Mon problème est le suivant: Je voudrais faire la même application dans la même feuille mais sur une autre plage de cellules et avec une autre case totale.
Pourriez-vous me dire comment je dois modifier mon code ?

Merci pour votre temps

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set Plage = Range("G13:M13,G17:L17")
Set plg = Application.Intersect(Plage, Selection)
If Not plg Is Nothing Then
Range("G24").Value = Range("G24").Value + Target.Value
Target.Offset(-1, 0).Select
End If
End Sub

 

[pierrejean]

Re : Modification de code pour click copie

bonjour Kouks

Atester:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set Plage = Range("G13:M13,G17:L17")
[COLOR=red]Set Plage2=Range("........")[/COLOR]
Set plg = Application.Intersect(Plage, Selection)
If Not plg Is Nothing Then
Range("G24").Value = Range("G24").Value + Target.Value
 
[COLOR=red]Set plg = Application.Intersect(Plage2, Selection)
If Not plg Is Nothing Then
Range("..").Value = Range("..").Value + Target.Value
[/COLOR]
Target.Offset(-1, 0).Select
 
 
End If
End Sub

 

[porcinet82]

Re : Modification de code pour click copie

Salut,

Je suis allé au plus simple. Je te laisse le soin d'adapter le code en rouge avec ta plage de cellule ainsi que la cellule résultat :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set Plage = Range("G13:M13,G17:L17")
Set plg = Application.Intersect(Plage, Selection)
Set Plage2 = Range("[COLOR=red]G100:M100,G100:L100[/COLOR]")
Set plg2 = Application.Intersect(Plage, Selection)
If Not plg Is Nothing Then
    Range("G24").Value = Range("G24").Value + Target.Value
    Target.Offset(-1, 0).Select
End If
If Not plg2 Is Nothing Then
    Range("[COLOR=red]G200[/COLOR]").Value = Range("[COLOR=red]G200[/COLOR]").Value + Target.Value
    Target.Offset(-1, 0).Select
End If
End Sub

@+

Edition : Arf, je ne t'avais pas vue PierreJean...

 

[Gorfael]

Re : Modification de code pour click copie

Bonjour tout le monde,

J'ai le code suivant qui me permet de cliquer sur une plage des cellules dont le contenue vient s'additionner dans une cellule total.

Mon problème est le suivant: Je voudrais faire la même application dans la même feuille mais sur une autre plage de cellules et avec une autre case totale.
Pourriez-vous me dire comment je dois modifier mon code ?

Merci pour votre temps

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set Plage = Range("G13:M13,G17:L17")
Set plg = Application.Intersect(Plage, Selection)
If Not plg Is Nothing Then
Range("G24").Value = Range("G24").Value + Target.Value
Target.Offset(-1, 0).Select
End If
End Sub

Salut
P'vez répéter la question ?!?
Tu redéfinis ta nouvelle plage et tu la re-teste :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Plage As Range
 
Set Plage = Application.Intersect(Target, Range("G13:M13,G17:L17"))
If Not (Plage Is Nothing) Then Range("G24") = Range("G24") + Target
 
Set Plage = Application.Intersect(Target, Range("G14:M14,G18:L18"))
If Not (Plage Is Nothing) Then Range("G25") = Range("G25") + Target
 
Cancel = True
End Sub

et autant de fois que tu le désires
Après, tout dépende de ce que tu veux quand (et si) il y a deux plages qui se chevauchent
S'il y a beaucoup de plages, passe par une boucle et un select case

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Plage As Range
Dim X As Integer
Dim Tot As Range
For X = 1 To 2
    Select Case X
        Case 1
            Set Plage = Intersect(Target, Range("G13:M13,G17:L17"))
            Set Tot = Range("G24")
        Case 2
            Set Plage = Intersect(Target, Range("G14:M14,G18:L18"))
            Set Tot = Range("G25")
    End Select
    
    If Not (Plage Is Nothing) Then Tot = Tot + Target
Next X
Cancel = True
End Sub

Cancel = True peut être remplacé par Target.Offset(-1, 0).Select, mais j'aime pas les select (^^)

A+

 

[Kouks]

Merci

Cher Pierrejean, Gorfael, porcinet82 et touts les autres,

Merci d'avoir répondus la solution de Gorfael est celle qui correcpond le mieux à mon besoin.

Merci encore

 

[Kouks]

Re : Modification de code pour click copie

Bonjour tout le monde,

Toujours dans le cadre de l'application qui suit, Je voudrais savoir si il était possible de changer la couleur de la cellule sur laquelle j'ai double cliqué et si aprés il était possible d'avoir un command button pour redonner la couleur initiale a ma cellule?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Plage As Range
 
Set Plage = Application.Intersect(Target, Range("G13:M13,G17:L17"))
If Not (Plage Is Nothing) Then Range("G24") = Range("G24") + Target
 
Set Plage = Application.Intersect(Target, Range("G14:M14,G18:L18"))
If Not (Plage Is Nothing) Then Range("G25") = Range("G25") + Target
 
Cancel = True
End Sub

Merci d'avance

 

[Gorfael]

Re : Modification de code pour click copie

Bonjour tout le monde,

Toujours dans le cadre de l'application qui suit, Je voudrais savoir si il était possible de changer la couleur de la cellule sur laquelle j'ai double cliqué et si aprés il était possible d'avoir un command button pour redonner la couleur initiale a ma cellule?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Plage As Range
 
Set Plage = Application.Intersect(Target, Range("G13:M13,G17:L17"))
If Not (Plage Is Nothing) Then Range("G24") = Range("G24") + Target
 
Set Plage = Application.Intersect(Target, Range("G14:M14,G18:L18"))
If Not (Plage Is Nothing) Then Range("G25") = Range("G25") + Target
 
Cancel = True
End Sub

Merci d'avance

Salut
oui et non : tu peux recolorier en blac les cellules en entrée de macro, et colorier target en sortie.
à force de vouloir simplifier le code, on en arrive à des abhération :
ton code t'interdit la modification d'une cellule de la feuille par double-clic

Donc, je serais plus partisant d'un code dans ce style :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
if Intersect(Target, Range("G13:M13,G17:L17,G14:M14,G18:L18")) is nothing then exit sub
Range("G13:M13,G17:L17,G14:M14,G18:L18").interior.colorindex = xlnone
 
If Not (Intersect(Target, Range("G13:M13,G17:L17")) Is Nothing) Then 
Range("G24") = Range("G24") + Target
else
Range("G25") = Range("G25") + Target
end if
Cancel = True
target.interior.colorindex = 3
End Sub

A+

 

[Kouks]

Re : Modification de code pour click copie

Merci Gorfael,

c beaucoup mieux