Ajouter un code VBA dans une feuille Excel par macro

Bonjour à tous,

je souhaiterai ajouter le code vba ci-dessous dans la feuille 1 de 150 fichier Excel qui se trouvent dans le même dossier
c'est pour cela que je souhaite automatiser l'insertion du code par macro vba :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$D$38" Then
    Select Case Target.Value
        Case Is = "Serious"
Target.Interior.ColorIndex = 6 'jaune
        Case Is = "Extreme"
Target.Interior.ColorIndex = 3 'rouge
        Case Is = "Low"
Target.Interior.ColorIndex = 35 'vert
        Case Is = "Moderate"
Target.Interior.ColorIndex = 34 'bleu ciel
        Case Else
Target.Interior.ColorIndex = -4142 'transparent
    End Select
 End If
End Sub

Merci pour votre aide

Bonjour,

dans un premier temps, voici une autre méthode pour réaliser ton action, au moyen de la fonction INDEX (MATCH en anglais)
Code:

1 2 3 4 5 6 7 8 9 10 11 Private Sub Worksheet_Change(ByVal Target As Range) Dim TabVal(): TabVal = Array("Serious", "Extreme", "Low", "Moderate") Dim TabCoul(): TabCoul = Array(6, 3, 35, 34) With Target .Interior.ColorIndex = -4142 On Error Resume Next If .Address = "$D$38" Then .Interior.ColorIndex = TabCoul(Application.Match(.Value, TabVal, False) - 1) End With End Sub
Concernant ton sujet, voici comment écrire la procédure dans la feuille dont le CodeName est "Feuil1"

je te laisse mettre en place la boucle qui ouvre et ferme les 150 fichiers, si tu as un problème, explique ce que tu n'arrives pas à faire
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub AutoEcriture() Dim Lig As Integer, Wb As Workbook Set Wb = ThisWorkbook ' Workbooks.Open("LeFichier") With Wb.VBProject.VBComponents("Feuil1").CodeModule Lig = 1 .InsertLines Lig, "Private Sub Worksheet_Change(ByVal Target As Range)": Lig = Lig + 1 .InsertLines Lig, "Dim TabVal(): TabVal = Array(""Serious"", ""Extreme"", ""Low"", ""Moderate"")": Lig = Lig + 1 .InsertLines Lig, "Dim TabCoul(): TabCoul = Array(6, 3, 35, 34)": Lig = Lig + 1 .InsertLines Lig, "With Target": Lig = Lig + 1 .InsertLines Lig, ".Interior.ColorIndex = -4142": Lig = Lig + 1 .InsertLines Lig, "On Error Resume Next": Lig = Lig + 1 .InsertLines Lig, "If .Address = ""$D$38"" Then .Interior.ColorIndex = TabCoul(Application.Match(.Value, TabVal, False) - 1)": Lig = Lig + 1 .InsertLines Lig, "End With": Lig = Lig + 1 .InsertLines Lig, "End Sub": Lig = Lig + 1 End With End Sub
le second exemple se comprend aisément je pense, si tu veux conserver ta propre procédure, tu l'écris toujours de cette manière :

- commencer la ligne par " .InserLines Lig," pour ajouter une ligne
- mettre la ligne de code à écrire dans une chaine de caractère (et donc doubler les guillemets du code à écrire)
- terminer la ligne par " :Lig = Lig + 1" afin de préparer l'ajout de la ligne suivante

EDIT : et si tu ne veux pas passer par des variables Tableau, tu peux éventuellement utiliser la fonction Choose comme ça :
Code:

1 2 3 4 5 6 7 Private Sub Worksheet_Change(ByVal Target As Range) With Target .Interior.ColorIndex = -4142 On Error Resume Next If .Address = "$D$38" Then .Interior.ColorIndex = Choose(Application.Match(.Value, Array("Serious", "Extreme", "Low", "Moderate"), False), 6, 3, 35, 34) End With End Sub

Salut, tuto à lire : Visual Basic Editor