Discussion :

[arnaud03]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[joe.levrai]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[kiki29]

Salut, tuto à lire : Visual Basic Editor