(résolu) Combiner plusieurs codes (private sub _change + mise en forme d'après liste)

Ctrl-Alt-Suppr · 28 Août 2014

Bonjour à tous.

Niveau débutant ; j'utilise depuis 2 mois un code que l'on m'a fourni ici sur XL-DL.

Code:

 Private Sub Worksheet_change(ByVal Target As Range)

Dim T As Range
 If Not Intersect([_ETAPES_TABLEAU], Target) Is Nothing Then
   On Error Resume Next
      
  Set T = [_ETAPES].Find(Target, LookAt:=xlWhole)
   'cellule modifiée agrandie sur une ligne d'environ 50 colonnes)
    With Target.Offset(0, -1).Resize(1, 58)
            'Couleur du fond
        .Interior.ColorIndex = T.Interior.ColorIndex
            'Police gras italique couleur
        .Font.Bold = T.Font.Bold
        .Font.Italic = T.Font.Italic
        .Font.Color = T.Font.Color
        
   End With
  End If
End Sub

J'aimerai, si possible ajouter le même genre de code, pour d'autres colonnes.
Comment cumuler 2 codes (voir 3 ou 4 ...) dans une même feuille !?
Par avance, merci !

« ne fonctionne pas : »

Code:

Private Sub Worksheet_change(ByVal Target As Range)

Dim T As Range
 If Not Intersect([_ETAPES_TABLEAU], Target) Is Nothing Then
   On Error Resume Next
      
  Set T = [_ETAPES].Find(Target, LookAt:=xlWhole)
   'cellule modifiée agrandie sur une ligne d'environ 50 colonnes)
    With Target.Offset(0, -1).Resize(1, 58)
            'Couleur du fond
        .Interior.ColorIndex = T.Interior.ColorIndex
            'Police gras italique couleur
        .Font.Bold = T.Font.Bold
        .Font.Italic = T.Font.Italic
        .Font.Color = T.Font.Color
        
   End With
  End If
End Sub


Private Sub Worksheet_change(ByVal Target As Range)

Dim TT As Range
 If Not Intersect([_TYPES_TABLEAU], Target) Is Nothing Then
   On Error Resume Next
      
  Set TT = [_TYPES].Find(Target, LookAt:=xlWhole)
   'cellule modifiée agrandie sur une ligne d'environ 50 colonnes)
    With Target.Offset(0, -1).Resize(1, 2)
            'Couleur du fond
        .Interior.ColorIndex = T.Interior.ColorIndex
            'Police gras italique couleur
        .Font.Bold = T.Font.Bold
        .Font.Italic = T.Font.Italic
        .Font.Color = T.Font.Color
        
   End With
  End If
End Sub

« ne fonctionne pas : »

Modeste · 28 Août 2014

Re : Combiner plusieurs codes (private sub _change + mise en forme d'après liste)

Bonjour Ctrl-Alt-Suppr,

un code que l'on m'a fourni ici sur XL-DL

Ça ne doit pas être ici: ici tu es sur XLD

Plus sérieusement, il ne peut y avoir qu'une seule procédure événementielle Worksheet_Change pour une feuille.
Par contre, rien ne t'empêche de reprendre ce que tu as écrit dans la seconde et de venir le coller juste avant le End Sub dans la première ... si tu vois ce que je veux dire! (attention, dans la seconde tu fais référence à une variable 'T' au lieu de 'TT' (me semble-t-il) dans les 4 instructions de mise en forme.

Pour l'instant, sans voir le bout du fichier, on ne peut en dire plus!

Ctrl-Alt-Suppr · 28 Août 2014

Re : Combiner plusieurs codes (private sub _change + mise en forme d'après liste)

MERCI, ça fonctionne.

Private Sub Worksheet_change(ByVal Target As Range)

Dim TY As Range
If Not Intersect([_TYPES_TABLEAU], Target) Is Nothing Then
On Error Resume Next

Set TY = [_TYPES].Find(Target, LookAt:=xlWhole)
'cellule modifiée agrandie sur une ligne d'environ 3 colonnes)
With Target.Offset(0, -1).Resize(1, 2)
'Couleur du fond
.Interior.ColorIndex = TY.Interior.ColorIndex
'Police gras italique couleur
.Font.Bold = TY.Font.Bold
.Font.Italic = TY.Font.Italic
.Font.Color = TY.Font.Color
End With
End If

Dim ET As Range
If Not Intersect([_ETAPES_TABLEAU], Target) Is Nothing Then
On Error Resume Next

Set ET = [_ETAPES].Find(Target, LookAt:=xlWhole)
'cellule modifiée agrandie sur une ligne d'environ 50 colonnes)
With Target.Offset(0, -1).Resize(1, 58)
'Couleur du fond
.Interior.ColorIndex = ET.Interior.ColorIndex
'Police gras italique couleur
.Font.Bold = ET.Font.Bold
.Font.Italic = ET.Font.Italic
.Font.Color = ET.Font.Color
End With
End If

End Sub

(résolu) Combiner plusieurs codes (private sub _change + mise en forme d'après liste)

Ctrl-Alt-Suppr

XLDnaute Junior

Modeste

XLDnaute Barbatruc

Ctrl-Alt-Suppr

XLDnaute Junior

Discussions similaires