Fusionner 2 Worksheet_change

Bonjour,

l'un d'entre vous peut-il m'aider à fusionner ces deux macros en une s'il vous plait?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 21 Then
    Dim Couleur As Integer, I As Integer, R As Long
    R = Target.Row
    Select Case UCase(Target1)
    Case "RESOLU": Couleur = 4

    Case "PLANIFIER INTER": Couleur = 44

    Case "EN COURS": Couleur = 3

    Case Else: Couleur = 0
    End Select
    For I = 3 To 22
    Cells(R, I).Interior.ColorIndex = Couleur
    Next
    End If
End If
End Sub

et

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    If Target.Column = 11 Or Target.Column = 12 Then
        Target = TimeSerial(Left(Target, Len(Target) - 2), Right(Target, 2), 0)
    End If
    Application.EnableEvents = True
End Sub

J'ai essayé avec des "Not intersect" mais il y a toujours qu'une seule macro qui fonctionne.

Merci.

Salut,

Conseil : Essaye d'indenter ton code il sera BEAUCOUP plus lisible.

Perso j'aurais tenté de mettre le deuxième évènement en ELSE IF de ton premier

Dernière question, pourquoi désactiver les évènements ? dans ton deuxième code ?

Girodo,

Bonjour,

merci pour ta rapidité.

Le deuxième code est une copie du forum.

En ce qui concerne, "indenter" et le "else if", je débute tellement que je ne connais pas.

Je vais relire l'aide en ligne d'excel.

J'ai enlevé un End if en trop dans ton code et renommé "target1" par "target" pour ton select case.

J'ai aussi indenté ton code ça fonctionne pour la première partie.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 21 Then
    Dim Couleur As Integer, I As Integer, R As Long
    R = Target.Row

        Select Case UCase(Target)
        Case "RESOLU": Couleur = 4
        Case "PLANIFIER INTER": Couleur = 44
        Case "EN COURS": Couleur = 3
        Case Else: Couleur = 0
        End Select

            For I = 3 To 22
            Cells(R, I).Interior.ColorIndex = Couleur
            Next
    End If
End Sub

Girodo

bonjour,

Une possibilité (à vérifier...)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, iC%, iR&, Couleur%
If Target.Count = 1 Then
   If iC = 11 Or iC = 12 Then
      Application.EnableEvents = False
      Target = TimeSerial(Left(Target, Len(Target) - 2), Right(Target, 2), 0)
      Application.EnableEvents = True
   End If
If iC = 21 Then
   iR = Target.Row
   Select Case UCase(Target)
   Case "RESOLU": Couleur = 4
   Case "PLANIFIER INTER": Couleur = 44
   Case "EN COURS": Couleur = 3
   Case Else: Couleur = 0
   End Select
   For i = 3 To 22
      CellsR(iR, i).Interior.ColorIndex = Couleur
   Next
End If
End Sub

A+

Bonjour,

Merci Girodo pour mon code. En effet, a force d'essayer, je laisse trainer certaines choses.

Merci galopin01 mais ce code ne fonctionne pas.

Je cherche encore, et ai toujours besoin d'aide pour cela.

Merci

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, iC%, iR&, Couleur%
If Target.Count = 1 Then
iC = Target.Column
If iC = 11 Or iC = 12 Then
Application.EnableEvents = False
Target = TimeSerial(Left(Target, Len(Target) - 2), Right(Target, 2), 0)
Application.EnableEvents = True
End If
   If iC = 21 Then
   iR = Target.Row
      Select Case UCase(Target)
      Case "RESOLU": Couleur = 4
      Case "PLANIFIER INTER": Couleur = 44
      Case "EN COURS": Couleur = 3
      Case Else: Couleur = 0
      End Select
   For i = 3 To 22
      Cells(iR, i).Interior.ColorIndex = Couleur
   Next
   End If
   End If
End Sub
galopin01 a écrit :

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, iC%, iR&, Couleur%
If Target.Count = 1 Then
iC = Target.Column
If iC = 11 Or iC = 12 Then
Application.EnableEvents = False
Target = TimeSerial(Left(Target, Len(Target) - 2), Right(Target, 2), 0)
Application.EnableEvents = True
End If
   If iC = 21 Then
   iR = Target.Row
      Select Case UCase(Target)
      Case "RESOLU": Couleur = 4
      Case "PLANIFIER INTER": Couleur = 44
      Case "EN COURS": Couleur = 3
      Case Else: Couleur = 0
      End Select
   For i = 3 To 22
      Cells(iR, i).Interior.ColorIndex = Couleur
   Next
   End If
   End If
End Sub

Superbe!!!! Un immense merci galopin01.

Bonne journée

Rechercher des sujets similaires à "fusionner worksheet change"