VBA qui s'applique sur tous le classeur

[keurma]

Bonjour,

Comment modifier ce programme VBA pour qu'il s'applique a tous un classeur. D'avance merci.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Range
For Each X In Range("A1:BB62")

If X.Value = "RH" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "CA" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "FR" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "HS" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "JU" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RTT" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "CT" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "AN" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "MED" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RV" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "EF" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RF" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RTP" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "MAL" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "AC" Then X.Cells.Interior.ColorIndex = 15

Next X
End Sub

 

[jp14]

Re : VBA qui s'applique sur tous le classeur

Bonjour

Pour qu'une macro soit visible dans un classeur il faut supprimer le mot "Private".

La macro est une macro évènementielle : aide vba
"Cet événement se produit lorsque les cellules de la feuille de calcul sont modifiées par l'utilisateur ou par un lien externe"

Pour l'utiliser dans toutes les feuilles il faut écrire le corps de la procédure dans un module

sub change1( nomfeuille1 as string)
With Sheets(nomfeuille1)
Set plage = .Range("A1:BB62")
For Each X In plage

If X.Value = "
..........

Mettre cette macro dans toute les feuilles

Private Sub Worksheet_Change(ByVal Target As Range)
' appel de la procédure en passant le nom de la feuille qui lance la procédure
call change1(Target.Worksheet.Name) 
End Sub

JP

 

[Dull]

Re : VBA qui s'applique sur tous le classeur

Salut keurma, jp14, le Forum

ou met ton code dans le ThisWorkbook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'...
End Sub

Bonne Journée

 

[tototiti2008]

Re : VBA qui s'applique sur tous le classeur

Bonjour keurma,

pour répondre bêtement à la question, comme ça (code à placer dans Thisworkbook) :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Range
For Each X In Sh.Range("A1:BB62")
If X.Value = "RH" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "CA" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "FR" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "HS" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "JU" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RTT" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "CT" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "AN" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "MED" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RV" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "EF" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RF" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RTP" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "MAL" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "AC" Then X.Cells.Interior.ColorIndex = 15
Next X
End Sub

Maintenant, on peut ajouter que ce n'est pas du tout optimisé. à chaque fois que tu changes une cellule, il vérifie toutes les cellules...

donc pour ne traiter que celles qui changent :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Range
For Each X In Target
If X.Value = "RH" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "CA" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "FR" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "HS" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "JU" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RTT" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "CT" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "AN" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "MED" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RV" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "EF" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RF" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "RTP" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "MAL" Then X.Cells.Interior.ColorIndex = 15
If X.Value = "AC" Then X.Cells.Interior.ColorIndex = 15
Next X
End Sub

 

[keurma]

Re : VBA qui s'applique sur tous le classeur

Grand merci a tous. ca marche nickel.

 

[keurma]

Re : VBA qui s'applique sur tous le classeur

Par contre est ce que vous seriez ce que je dois mettre pour que la cellule redevienne blanche si elle est vide. Je pensais a ca :
If X.Value = "RC" Then X.Cells.Interior.ColorIndex = 2

Mais du coup ca m'a effacé aussi toutes les lignes grisés qui constitue les cellules du classeur. Merci pour votre aide

 

[Dull]

Re : VBA qui s'applique sur tous le classeur

Re keurma le Fil

Avec le code de Staple qui t'a fait une cure d'amaigrissement

Ajoute la ligne en Gras

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("A1:BB62")) Is Nothing Then
Select Case Target
Case "RH", "CA", "FR", "HS", "JU", "RH", "CA", "FR", "RTT", "CT", "AN", "MED", "RV", "EF", "RF", "RTP", "MAL", "AC"
Target.Interior.ColorIndex = 15
End Select
[B]If Target.Value = "" Then Target.Interior.ColorIndex = 0[/B]
End If
End Sub

EDITION: ...Etenplusilinsiste...lol
Bonne Journée

 

[job75]

Re : VBA qui s'applique sur tous le classeur

Bonjour à tous,

Plus simplement :

Target.Interior.ColorIndex = IIf(Target = "", xlNone, 15)

A+

 

[keurma]

Re : VBA qui s'applique sur tous le classeur

Merci c'est nickel