Mise en forme ligne (formes)

Tu as inversé

essaye ça

Private Sub Bouton173354_Cliquer()
    Dim num ' numéro du connecteurs courant
    Dim verif ' si le numéro existe
    Dim tableau As Variant
    Dim i ' compteur
    ' ces deux boucles recherchent s'il y a des connecteurs droits
    For Each f In Worksheets
        On Error Resume Next
        For Each sh In Sheets(f.Name).Shapes
            If Left(sh.Name, 5) = "trait" Then
                tableau = Split(sh.Name, " ")
                num = tableau(1)
                i = 5
                verif = False
                While Cells(i, 1) <> ""
                    If Right(Cells(i, 1), 3) = num Or Right(Cells(i, 1), 4) = num Then
                        ActiveSheet.Shapes.Range(Array(sh.Name)).Select
                        With Selection.ShapeRange.Line
                           .Font.Color = RGB(255, 0, 0)
                           .Weight = 5
                           End With
                        verif = True
                    End If
                    i = i + 1
                Wend

                If Not verif Then
                    ActiveSheet.Shapes.Range(Array(sh.Name)).Select
                    With Selection.ShapeRange.Line
                        .ForeColor.RGB = RGB(0, 0, 0)
                        .Weight = 3
                    End With
                End If
            End If
        Next
    Next

End Sub

Salut Psykopat,

C'est bon, j'ai trouvé et tout fonctionne correctement au niveau formule et macro.

Les sections exactes sont sous le format W0140. J'ai donc adapté les dénominations des traits en conséquences.

Cependant, j'ai encore un petit souci :

La dénomination de la ligne est en réalité dans une phrase comme ça :

Aptitude Sections de Lignes

W0142 : XXXXX - XXXXX

(Apt)

J'ai donc besoin si tu te rappelles d'extraire soit W0142, soit dans certains cas W0142a.

On ne peut pas partir de droite car le nombre de caractère n'est jamais le même. C'est en revanche toujours le m^me nombre de caractère en partant de la gauche.

J'ai donc remplacé right par left mais sans succès ...

Voici le code :

Private Sub Bouton173354_Cliquer()
    Dim num ' numéro du connecteurs courant
    Dim verif ' si le numéro existe
    Dim tableau As Variant
    Dim i ' compteur
    ' ces deux boucles recherchent s'il y a des connecteurs droits
    For Each f In Worksheets
        On Error Resume Next
        For Each sh In Sheets(f.Name).Shapes
            If Left(sh.Name, 5) = "trait" Then
                tableau = Split(sh.Name, " ")
                num = tableau(1)
                i = 5
                verif = False
                While Cells(i, 1) <> ""
                    If Left(Cells(i, 28), 4) = num Or Left(Cells(i, 28), 5) = num Then
                        ActiveSheet.Shapes.Range(Array(sh.Name)).Select
                        With Selection.ShapeRange.Line
                           .ForeColor.RGB = RGB(0, 255, 0)
                           .Weight = 2
                           End With
                        verif = True
                    End If
                    i = i + 1
                Wend

                If Not verif Then
                    ActiveSheet.Shapes.Range(Array(sh.Name)).Select
                    With Selection.ShapeRange.Line
                        .ForeColor.RGB = RGB(255, 0, 0)
                        .Weight = 5
                    End With
                End If
            End If
        Next
    Next

End Sub

Tu en penses quoi ?

Voilà

Private Sub Bouton173354_Cliquer()
    Dim num ' numéro du connecteurs courant
    Dim verif ' si le numéro existe
    Dim tableau As Variant
    Dim i ' compteur
    ' ces deux boucles recherchent s'il y a des connecteurs droits
    For Each f In Worksheets
        On Error Resume Next
        For Each sh In Sheets(f.Name).Shapes
            If Left(sh.Name, 5) = "trait" Then
                tableau = Split(sh.Name, " ")
                num = tableau(1)
                i = 5
                verif = False
                While Cells(i, 1) <> ""
                    If Mid(Cells(i, 28), 2, 3) = num Or Mid(Cells(i, 28), 2, 4) = num Then
                        ActiveSheet.Shapes.Range(Array(sh.Name)).Select
                        With Selection.ShapeRange.Line
                           .ForeColor.RGB = RGB(0, 255, 0)
                           .Weight = 2
                           End With
                        verif = True
                    End If
                    i = i + 1
                Wend

                If Not verif Then
                    ActiveSheet.Shapes.Range(Array(sh.Name)).Select
                    With Selection.ShapeRange.Line
                        .ForeColor.RGB = RGB(255, 0, 0)
                        .Weight = 5
                    End With
                End If
            End If
        Next
    Next

End Sub

Salut Psykopat !!

Je voulais juste te remercier. Le projet est fini, plus que la mise en forme mais ça va nous améliorer la vie d'une forçe

Merci à toi en tous cas, je n'aurai rien pu faire sans toi. Si tu es sur Paris, n'hésite pas à me contacter, je t'invite à boire un coup sans soucis 8) 8)

Je suis du Havre mais si je passe par Paris je te fais signe