Aide pour modification de codes VBA

[melba]

Bonjour,

Je ne connais pas la programmation et après avoir vainement essayé de compléter 2 codes VBA qui m'ont été donnés sur ce forum je ne vois pas d'autre solution que de faire encore appel à vous.

1) Je souhaiterais compléter le code suivant :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("d7:d17")) Is Nothing Or Target.Count > 1 Then Exit Sub
Cancel = True
Range("E" & Target.Row) = Range("E" & Target.Row) - Target
Target = ""
End Sub

pour indiquer que sont aussi concernées :

les cellules h7:h17 et colonne I

les cellules L7:L17 et colonne M

Dans mon fichier réel j'aurai d'autres plages mais la configuration sera la même.


2) je souhaiterais compléter le code suivant :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("d7:d17")) Is Nothing Or Target.Count > 1 Then Exit Sub
Range("E" & Target.Row) = Range("E" & Target.Row) + Target
End Sub

pour indiquer que sont les mêmes zones que mentionnées plus haut sont concernées.

Comme plus haut, dans mon fichier réel j'aurai d'autres plages mais la configuration sera la même.

Je joins un fichier exemple.

Y-a-t-il quelqu'un pour m'aider?

Merci par avance

 

[Pierrot93]

Re : Aide pour modification de codes VBA

Bonjour,

pas ouvert ton fichier, mais si tu veux rajouter d'autres plages :

If Intersect(Target, Range("d7:d17,h7:I17,L7:M17")) Is Nothing Or Target.Count > 1 Then Exit Sub

enfin si j'ai bien compris..

bonne soirée
@+

 

[melba]

Re : Aide pour modification de codes VBA

Bonsoir,

Merci de vous pencher sur mon problème : je vois donc que pour indiquer plusieurs zones je dois utiliser le virgule comme séparateur.

Cependant ce que je faisais sur les cellules de la plage d7:d17 avait une incidence sur les cellules adjacentes se trouvant en colonne E.

Maintenant je veux compléter le code pour que l'action sur les cellules de la plage h7:h17 ait une incidence sur la colonne I.

De même pour L7:L17 et colonne M.

Si j'ajoute H7:H17 dans les codes existants comment par ailleurs indiquer que l'incidence doit alors porter sur la colonne I?

Il est peut être nécessaire d'écrire plusieurs codes à l'identique des 2 qui existent déjà.

Mais alors là j'ai le message: "nom ambigu" et je ne sais pas comment procéder ne connaissant pas la programmation?

Merci pour votre aide.

@+

 

[Robert]

Re : Aide pour modification de codes VBA

Bonsoir Melba, Pierrot, bonsoir le forum,

peut-ête comme ça :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)If Application.Intersect(Target, Application.Union(Range("D7:D17"), Range("H7:H17"), Range("L7:L17"))) Is Nothing Or Target.Count > 1 Then Exit Sub
Cancel = True
Select Case Target.Column
    Case 4
        Range("E" & Target.Row) = Range("E" & Target.Row) - Target
    Case 8
        Range("I" & Target.Row) = Range("I" & Target.Row) - Target
    Case 12
        Range("M" & Target.Row) = Range("M" & Target.Row) - Target
End Select
Target = ""
End Sub

 

[melba]

Re : Aide pour modification de codes VBA

Bonjour,

Merci pour ce nouveau code, je regarde ce soir après le travail

Bonne journée

 

[melba]

Re : Aide pour modification de codes VBA

Bonsoir,

J'ai intégré le code ci-dessus dans le fichier que j'avais posté au début et il fonctionne super bien. J'en suis ravie et vous dis un grand merci.

En ce qui concerne l'autre code qui me permet de faire un cumul automatique entre ma saisie journalière et le total qui avait été enregistré précédemment, comment le compléter pour qu'il soit opérant sur les mêmes cellules et colonnes que dans le code que vous avez modifié?

Soit :
H7:H17 et colonne I?
L7:L17 et colonne M?



Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("d7:d17")) Is Nothing Or Target.Count > 1 Then Exit Sub
Range("E" & Target.Row) = Range("E" & Target.Row) + Target
End Sub

@+

 

[Robert]

Re : Aide pour modification de codes VBA

Bonjour le fil, bonjour le forum,

Melba, je pense que ce code ci-dessous devrait suffire. On n'a même pas besoin du Select Case, puisque il y a déjà la condition avant qui sort de la procédure si on n'est pas dans la bonne colonne..

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'si la cellule active ne se trouve ni dans la plage D7:D17, ni dans la plage H7:H17, ni dans la plage L7:L17, sort de la procédure
If Application.Intersect(Target, Application.Union(Range("D7:D17"), Range("H7:H17"), Range("L7:L17"))) Is Nothing Or Target.Count > 1 Then Exit Sub
Cancel = True 'annule le menu contextuel lié au clic du bouton droit
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value - Target.Value 'modifie la cellule adjacente
Target = "" 'vide la cellule dans laquelle le clic droit a été fait
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'si la cellule active ne se trouve ni dans la plage D7:D17, ni dans la plage H7:H17, ni dans la plage L7:L17, sort de la procédure
If Application.Intersect(Target, Application.Union(Range("D7:D17"), Range("H7:H17"), Range("L7:L17"))) Is Nothing Or Target.Count > 1 Then Exit Sub
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value + Target.Value 'modifie la cellule adjacente
End Sub

 

[melba]

Re : Aide pour modification de codes VBA

Bonsoir,

Merci pour la proposition, je viens d'essayer les 2 codes et à moins d'une erreur dans la copie de ma part, c'est malheureusement sans effet alors que le 1er code fourni :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)If Application.Intersect(Target, Application.Union(Range("D717"), Range("H7:H17"), Range("L7:L17"))) Is Nothing Or Target.Count > 1 Then Exit Sub
Cancel = True
Select Case Target.Column
Case 4
Range("E" & Target.Row) = Range("E" & Target.Row) - Target
Case 8
Range("I" & Target.Row) = Range("I" & Target.Row) - Target
Case 12
Range("M" & Target.Row) = Range("M" & Target.Row) - Target
End Select
Target = ""
End Sub

fonctionnait bien pour ce qui était de l'annulation de la saisie par clic droit.

Merci pour votre analyse.

@+

 

[Si...]

Re : Aide pour modification de codes VBA

salut

Si... tu avais daigné me dire ce qui ne convenait pas ici j'aurais pu te proposer autre chose !

à Robert, plutôt que de passer par "Union", avec la proposition de Pierrot93 cela peut donner :

Private Sub Worksheet_Change(ByVal R As Range)
  If Not Intersect(R, Range("D7:D17,H7:H17,L7:L17")) Is Nothing Then
    If IsNumeric(R) Then
      R(1, 2) = R(1, 2) + R
    Else
      Application.EnableEvents = False: R = "": R.Select: Application.EnableEvents = True
    End If
  End If
End Sub

 

[Robert]

Re : Aide pour modification de codes VBA

Bonsoir le fil, bonsoir le forum,

Tout à fait exact Si mais c'est une sale habitude que j'ai prise avec Union...

 

[melba]

Re : Aide pour modification de codes VBA

Bonsoir,

Désolée Si, en fait je n'avais pas très bien compris le fonctionnement de ton code, je n'avais plus le cumul.

En ce qui concerne la correction que tu as apportée à la proposition de Robert c'est nickel.

Private Sub Worksheet_Change(ByVal R As Range)
If Not Intersect(R, Range("D717,H7:H17,L7:L17")) Is Nothing Then
If IsNumeric(R) Then
R(1, 2) = R(1, 2) + R
Else
Application.EnableEvents = False: R = "": R.Select: Application.EnableEvents = True
End If
End If
End Sub

J'ai complété comme suit pour que ça fonctionne dans tout mon tableau "test". J'espère que je parviendrai à le reproduire dans mon fichier réel.

En ce qui concerne le code de Robert du 13/01/2013 20h26, j'ai complété comme suit et j'ai le résultat escompté :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Application.Intersect(Target, Application.Union(Range("D717"), Range("H7:H17"), Range("L7:L17"), Range("D2434"), Range("H24:H34"), Range("L24:L34"))) Is Nothing Or Target.Count > 1 Then Exit Sub
Cancel = True
Select Case Target.Column
Case 4
Range("E" & Target.Row) = Range("E" & Target.Row) - Target
Case 8
Range("I" & Target.Row) = Range("I" & Target.Row) - Target
Case 12
Range("M" & Target.Row) = Range("M" & Target.Row) - Target
End Select
Target = ""
End Sub


Que signifie Case 4 et case 12?

En tout cas je vous remercie très chaleureusement.

Je joins mon fichier test modifié.
@+

 

[Si...]

Re : Aide pour modification de codes VBA

salut

pour la seconde macro dans le même style que celle que j'ai donnée

Private Sub Worksheet_BeforeRightClick(ByVal R As Range, Cancel As Boolean)
  If Intersect(R, Range("D7:D17,H7:H17,L7:L17,D24:D34,H24:H34,L24:L34")) Is Nothing Then Exit Sub
  Cancel = True
  R(1, 2) = R(1, 2) - R
  R = ""
End Sub

Les 4, 8 et 12 de la macro de Robert correspondent aux numéros des colonnes D, H et L.
Maintenant, Si... tu as d'autres mois il faudra sans doute revoir les lignes de test des évènements (seconde ligne).

 

[melba]

Re : Aide pour modification de codes VBA

Bonjour,

J'ai effectivement essayé d'ajouter un mois et ai complété le code sur la 2ème ligne comme suit :

If Application.Intersect(Target, Application.Union(Range("D717"), Range("H7:H17"), Range("L7:L17"), Range("D2434"), Range("H24:H34"), Range("L24:L34"), Range("D41:51")))) Is Nothing Or Target.Count > 1 Then Exit Sub

et j'ai un message d'erreur " erreur syntaxe", "erreur compilation", comment faire?

Le code pour le cumul de saisie quant à lui fonctionne bien.

Un grand merci par avance

@+

 

[Si...]

Re : Aide pour modification de codes VBA

salut

il est des fois ou l'UNION fait la force, n'est-ce pas Robert ?
La plage de contrôle est définie à l'ouverture du classeur (évènementielle dans ThisWorkbook)

Voir les explications pour l'adaptation en fonction du nombre de mois.
Je te propose de jeter un coup d'œil sur les formules que j'avais remaniées dans l'autre fil.

 

[melba]

Re : Aide pour modification de codes VBA

Bonjour,

Je vois que ça fonctionne très bien mais vous avez modifié les codes et je suis perdue.

Ne vous étonnez pas si vous n'avez pas de nouvelles de moi avant la fin de l'après midi , je pense qu'il me faut bien ça pour comprendre les explications fournies.

Vous allez me rendre folle.

A tout à l'heure