Ajouter des arguments à une procédure
Bonjour,
Il y a deux choses différentes dans ce qu'on a évoqué, d'abord la saisie d'un code inexistant : elle déclenche une erreur, récupérée et qui fait sortir de la procédure (mais laisse le faux code en C).
Deux réactions possibles : on annule l'opération ce qui rétablira le code remplacé par un code erroné (sans toucher aux autres données préexistantes). Il faut donc placer la procédure d'annulation dans la gestion d'erreur (sous l'étiquette), l'annulation impose de l'exécuter en interrompant les évènement, faire précéder l'étiquette d'une instruction Exit Sub (sans quoi on annulerait toutes les opérations à chaque fois !). Donc : Exit Sub ; étiquette ; évènements à False ; annulation ; évènements à True.
Et on teste pour vérifier l'absence d'impacts "colatéraux"...
Ou bien, à la saisie d'un faux code, on supprime le faux code et on supprime également les données liées à l'ancien en D E F.
On peut ici aussi utiliser la gestion d'erreur mais n'opérer que la suppression de la valeur erronée en C, qui relancera l'évènement pour supprimer les valeurs erronées. Au lieu de renvoyer à une étiquette, il serait sans doute alors préférable de gérer avec un instruction On Error Resume Next, suivie après la ligne susceptible de déclencher l'erreur d'un test déterminant s'il y a erreur et dans ce cas, on ramène Err.Number à 0 et on efface la cellule sur laquelle on est en train d'intervenir, et on sort. Le retour de la procédure fera le reste.
L'autre problème évoqué est plus délicat, je le laisse de côté pour l'instant, tu as de quoi t'entrainer.
A+
Super merci je vais essayer
J'espère que tes essais se poursuivent dans de bonnes conditions...
J'avais réécrit dans le courant de la nuit
A+
Sans mentir j'ai beaucoup de mal, car même si ce code VBA est dans le fichier que je dois rendre pour mon projet, il y a d'autre chose à côté pour mon projet et qui me demande beaucoup de temps malheureusement. Ce soir, très tard surement
Salut !
Vois cette nouvelle version :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim coul&, n%, r As Range, hd
If Target.Row < 3 Then Exit Sub
If Intersect(Target, Me.Columns("C:E")) Is Nothing Then Exit Sub
For Each r In Intersect(Target, Me.Columns("C:E")).Rows
If Me.Cells(r.Row, 3) <> "" Then
On Error Resume Next
n = WorksheetFunction.Match(Me.Cells(r.Row, 3), [TABLEAU_COULEUR].Columns(1), 0)
If Err.Number <> 0 Then
Err.Number = 0
Me.Cells(r.Row, 3).ClearContents
Exit Sub
End If
coul = [TABLEAU_COULEUR].Cells(n, 4).Interior.Color
hd = [TABLEAU_COULEUR].Cells(n, 2).Resize(, 2).Value
Application.EnableEvents = False
Me.Cells(r.Row, 6).Interior.Color = coul
Me.Cells(r.Row, 4).Resize(, 2).Value = hd
Application.EnableEvents = True
Else
Application.EnableEvents = False
Me.Cells(r.Row, 6).Interior.ColorIndex = xlColorIndexNone
Me.Cells(r.Row, 4).Resize(, 3).ClearContents
Application.EnableEvents = True
End If
Next r
End SubLes changements :
- On étend la zone d'intersection prise en compte par la macro aux colonnes C à E.
- Compte tenu que l'intersection peut occuper 3 colonnes au lieu d'une, on ne considère plus la cellule mais la ligne renvoyée en tant que plage (variable r) dans la boucle ForEach... Next. Mais de cette ligne, on tire le numéro de ligne pour tester la cellule en colonne C.
- Ainsi à partir de changements sur 3 colonnes, on revient sur le contenu de la colonne déterminante en C. Et on peut traiter l'ensemble à partir du contenu de la cellule en C.
- La gestion d'erreur est modifiée pour traiter immédiatement le cas de faux code saisi en C : si erreur, on efface la cellule, et on sort.
- Rien de changé sur la suite, sauf que l'interruption des évènements lors des modifications devient obligatoire pour éviter une boucle infinie. Elle est fait très sélectivement pour couvrir les modifications sur les 3 colonnes.
- En cas d'effacement, l'effacement couvre aussi la colonne F (en considérant la possibilité d'y avoir mis une mention, mais qui concernait alors les valeurs effacées, et donc peut être effacée aussi).
Bon courage.
Merci bien !
Effectivement lors de mes essais, je n'avais absolument penser à changer la zone d'intersection, je ne pensais qu'à mettre des if...
Enfin toujours est il qu'il fonctionne super bien, et qu'il ne me reste plus qu'à insérer la msgbox pour signaler que le code RAL est faux et qu'il faut en entrer un valide.
Merci beaucoup
A mettre dans la condition qui identifie l'erreur, avant le Exit Sub...
Bonsoir,
Voici le code avec l'ajout de la msgbox et des annotations pour confirmation
Merci beaucoup d'avance
Private Sub Worksheet_Change(ByVal Target As Range) ' Procédure intervenant à chaque changement de valeur dans la feuille, Target est la plage modifiée
Dim coul&, n%, r As Range, hd ' Déclaration des variables
If Target.Row < 3 Then Exit Sub ' Si la plage modifiée ne se situe pas après la ligne 3, la procédure s'arrête
If Intersect(Target, Me.Columns("C:E")) Is Nothing Then Exit Sub ' Si la plage modifiée ne se trouve pas dans entre les colonnes C et E, la procédure s'arrête
For Each r In Intersect(Target, Me.Columns("C:E")).Rows ' Balayage de la plage impactée (si comporte plusieurs cellules)
If Me.Cells(r.Row, 3) <> "" Then ' Si la cellule n'est pas vide alors...
On Error Resume Next ' S'il y a une erreur, la procédure est directement renvoyée à la valeur suivante
n = WorksheetFunction.Match(Me.Cells(r.Row, 3), [TABLEAU_COULEUR].Columns(1), 0) ' Recherche de la ligne où apparaît la valeur exacte du code RAL dans la plage "TABLEAU_COULEUR"
If Err.Number <> 0 Then ' Si le gestionnaire d'erreur en détecte (<>0) alors...
If MsgBox(Target & " n'est pas un code RAL valide," & Chr(10) & " veuillez en rentrer un autre.", vbExclamation, "Valeur fausse") = vbOK Then ' Une boîte de dialogue avec "Valeur fausse" en titre apparaît avec la valeur rentrée et un message, Chr(10) = retour à la ligne et vbExclamation = fait apparaitre un point d'exclamation dans la boite de dialogue
Err.Number = 0 ' Le gestionnaire d'erreur est réinitialisé
Me.Cells(r.Row, 3).ClearContents ' Les cellules où a lieu l'erreur sont nettoyées
End If
Exit Sub ' La procédure s'arrête
End If
coul = [TABLEAU_COULEUR].Cells(n, 4).Interior.Color ' Récupération de la couleur dans la 4ème colonne de la plage "TABLEAU_COULEUR" sur la ligne recherchée précédemment
hd = [TABLEAU_COULEUR].Cells(n, 2).Resize(, 2).Value ' Récupération du texte dans la 2nde colonne de la plage "TABLEAU_COULEUR" et de la 2nde colonne (soit la 3ème colonne) par rapport la valeur de la ligne recherchée précédemment
Application.EnableEvents = False ' Désactivation des évènements par sécurité
Me.Cells(r.Row, 6).Interior.Color = coul ' Affectation de la couleur dans la 3ème colonne après le code RAL
Me.Cells(r.Row, 4).Resize(, 2).Value = hd ' Affectattion du texte dans la 1ère et 2nde colonne après le code RAL
Application.EnableEvents = True ' Réactivation des évènements
Else ' Si la cellule ne comporte plus de valeur alors...
Application.EnableEvents = False ' Désactivation des évènements par sécurité
Me.Cells(r.Row, 6).Interior.ColorIndex = xlColorIndexNone ' Supprime la couleur de la 3ème colonne après le code RAL
Me.Cells(r.Row, 4).Resize(, 3).ClearContents ' Supprime le texte dans la 1ère et 2nde colonne après le code RAL
Application.EnableEvents = True ' Réactivation des évènements
End If
Next r ' On passe à la ligne suivante
End SubBonsoir,
Juste un point, il faut que tu remplaces Target par Me.Cells(r.Row, 3) dans ton MsgBox. Target pouvant comporter plusieurs cellules il faut pointer la cellule qui est en C... Certes cette erreur ne se produira pas lors d'un effacement et ne peut se produire en principe que lors de la frappe d'un code en C, mais on ne peut toutefois exclure que quelqu'un vienne mettre plusieurs codes par collage...
Sinon le test sur le bouton de la MsgBox, tu peux t'en dispenser, tu n'as qu'un bouton OK et l'utilisateur est dans tous les cas obligé de cliquer OK pour que la boîte disparaisse...
Une petite précision sur la boucle : la variable r est de type Range (mais Range est un type un peu multiforme), on effectue la boucle non pas sur des cellules individualisées, mais sur les lignes de la plage d'intersection, et à partir de la ligne on va pointer la cellule de la ligne en C (même si elle n'est pas comprise dans l'intersection) car c'est sa valeur qui est déterminante. r est la variable objet qui permet de boucler sur les lignes de l'intersection mais pour pouvoir pointer la bonne cellule c'est le numéro de ligne qu'il nous faut, qui est donc renvoyé par r.Row.
Bonne continuation. Cordialement.
Bonjour,
Très bien merci c'est noté
Concernant le test sur le bouton, je suis obligé de le mettre ( je ne comprend pas pourquoi...) car si je le met pas et que j'écris ma ligne de code comme ça :
MsgBox(Me.Cells(r.Row, 3) & " n'est pas un code RAL valide," & Chr(10) & " veuillez en rentrer un autre.", vbExclamation, "Valeur fausse")J'ai ce message d'erreur qui apparaît : "Erreur de complilation: Attendu : ="
Cordialement
Parce qu'il faut pas mettre de parenthèse dans ce cas : MsgBox est une fonction :
If MsgBox(message, vbExclamation, titre) = vbOK
ou
a = MsgBox(message, vbExclamation, titre)utilisation en tant que fonction, pour renvoyer une valeur.
MsgBox message, vbExclamation, titreutilisation comme procédure d'affichage de message.
Mais MsgBox(message) est accepté [avec seulement le premier argument].
Cordialement.
Super !
Et bien mon code est achevé maintenant, un grand merci à vous MFerrand, vous m'avez énormément aidé pour mon projet de fin d'étude et vous m'avez appris beaucoup de chose dans la programmation VBA.
A bientôt dans un autre sujet !
Bonne continuation.