Discussion :

[bilou_12]

Bonjour,

j'ai une plage de cellules fussionnées de P6 à P40!

Dans cette cellule, j'ai des phrases et je cherche à souligner uniquement les mots "Achat", "Vente" ou "Echu J+1"!

Pour le moment, j'ai essayé 2 trucs:

Code :

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

1
2
3
        'Worksheets(feuilleReporting).Cells(ligneDebutReporting, colRepOpeRecente).Find("Achat").Font.Underline = xlUnderlineStyleSingle
        'Worksheets(feuilleReporting).Cells(ligneDebutReporting, colRepOpeRecente).Find("Vente:").Font.Underline = xlUnderlineStyleSingle
        'Worksheets(feuilleReporting).Cells(ligneDebutReporting, colRepOpeRecente).Find("Echu J+1:").Font.Underline = xlUnderlineStyleSingle

Mais ca plante!

Ou

Code :

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

1
2
3
4
5
6
        aSouligner = "Achat"
 
        Set cellule = Worksheets(feuilleReporting).Cells(ligneDebutReporting, colRepOpeRecente)
        pos = InStr(1, cellule.Value, aSouligner)
 
        cellule.Characters(pos, Len(aSouligner)).Font.Underline = xlUnderlineStyleSingle

Mais cela me souligne que le premier "Achat"!

Quelqu'un a une idée pour régler mon pb?

Merci d'avance!

[fring]

Bonjour,

A adapter en fonction du nom de la feuille et de la colonne à parcourir

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 test()
Dim i As Long, Pos As Long, Dep As Long
 
With Sheets("Feuil1")
    For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
        Dep = 1
        Pos = InStr(Dep, UCase(.Cells(i, 1)), "ACHAT")
        Do
            If Pos <> 0 Then
                .Cells(i, 1).Characters(Pos, 5).Font.Underline = xlUnderlineStyleSingle
                Dep = Pos + 1
                Pos = InStr(Dep, UCase(.Cells(i, 1)), "ACHAT")
            End If
        Loop While Pos <> 0
    Next
End With
 
End Sub

[bilou_12]

Merci fring!

J'ai pas besoins de boucler sur les cellules car elles sont fusionnées donc je l'ai arrangé de la manière suivante:

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 SouligneMot(ByVal feuille As String, ByVal cellule As String, ByVal aSouligner As String)
Dim i As Long, Pos As Long, Dep As Long
 
With Sheets(feuille)
 
    Dep = 1
    Pos = InStr(Dep, .Range(cellule), aSouligner)
    Do
        If Pos <> 0 Then
            .Range("P6").Characters(Pos, 5).Font.Underline = xlUnderlineStyleSingle
            Dep = Pos + 1
            Pos = InStr(Dep, .Range("P6"), aSouligner)
        End If
    Loop While Pos <> 0
 
End With
 
End Sub