Discussion :

[PeterPan1969]

Bonjour,

J'espère être clair, je ne connais pas les bon mots pour faire une recherche efficace sur ce sujet...

Je souhaite faire une mise en forme automatique en fonction des caractères (x.xx, x.xx.xx ou x.xx.xx.x - les x étant de chiffres) et mettre une mise en forme différente (gras/italique, augmenter le retrait...) pour chaque groupe de caractère.
Le but est d'intégrer ce code vba dans un code plus complet (intégrant des split et fusion de cellules..)

Contrainte n°2, il faut faire la même mise en forme pour la cellule attenante

Exemple 1 :
Cellule A1 : 3.01 et Cellule A2 : Texte
Devient Cellule A1 : 3.01 (gras) et Cellule A2 : texte (gras)

Exemple 2 :
A1 : Cellule 3.01.02 et Cellule A2 : Texte
Devient Cellule A1 : 3.01.02 (en italique) et Cellule A2 : texte (en italique)


D'avance merci

[Menhir]

Je souhaite faire une mise en forme automatique en fonction des caractères (x.xx, x.xx.xx ou x.xx.xx.x - les x étant de chiffres) et mettre une mise en forme différente (gras/italique, augmenter le retrait...) pour chaque groupe de caractère.

Si le critère est le nombre de caractères, il suffit de faire une MFC par longueur différente en utilisant une formule du type =NBCAR(A1)=4 pour x.xx, par exemple.

Le but est d'intégrer ce code vba dans un code plus complet (intégrant des split et fusion de cellules..)

Pour créer une mise en forme conditionnelle en VBA, lire ça : https://docs.microsoft.com/fr-fr/off...ectedfrom=MSDN

Contrainte n°2, il faut faire la même mise en forme pour la cellule attenante
Exemple 1 :
Cellule A1 : 3.01 et Cellule A2 : Texte
Devient Cellule A1 : 3.01 (gras) et Cellule A2 : texte (gras)

Si la cellule attenante est celle du dessous, il suffit d'appliquer la mise en forme aux deux cellules et, dans la formule, mettre la référence de ligne en absolu avec un $.
Par exemple =NBCAR(A$1)=4.

[mfoxy]

Bonjour PeterPan,


Ci-dessous un code qui devrait répondre a ta demande,
A modifier dans le code le nom de ta feuille

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
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
Sub test()
 
Dim i As Long
Dim wb As Workbook
Dim ws As Worksheet
 
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1") ' Sheet1 à remplacer par le nom de la feuille
 
For i = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row Step 2
 
    Select Case CountCharacter(ws.Cells(i, 1).value, ".")
 
      Case 0 ' la cellule ne compte pas de "."
      Case 1 ' la cellule compte un seul "."
       ws.Range(Cells(i, 1), Cells(i + 1, 1)).Font.FontStyle = "Bold"
      Case 2 ' la cellule compte un deux "."
       ws.Range(Cells(i, 1), Cells(i + 1, 1)).Font.FontStyle = "Italic"
      Case 3 ' la cellule compte trois "."
       ws.Range(Cells(i, 1), Cells(i + 1, 1)).Font.FontStyle = "Bold Italic"
      Case Else ' Autre cas msg d'alerte
       MsgBox "Attention , la cellule A" & i & " compte " & CountCharacter(Cells(i, 1).value, ".") & " points ce cas de figure n'a pas été codé."
 
    End Select
 
Next i
 
Set ws = Nothing
Set wb = Nothing
 
End Sub
 
Function CountCharacter(strText As String, strFind As String, _
                                Optional lngCompare As VbCompareMethod) As Long
 
' Fonction permettant de compté le nombre de fois ou un caractère ( strFind) se trouve dans la chaine de caract (strText)
 
Dim lngPos As Long
Dim lngTemp As Long
Dim lngCount As Long
    If Len(strText) = 0 Then Exit Function
    If Len(strFind) = 0 Then Exit Function
    lngPos = 1
    Do
        lngPos = InStr(lngPos, strText, strFind, lngCompare)
        lngTemp = lngPos
        If lngPos > 0 Then
            lngCount = lngCount + 1
            lngPos = lngPos + Len(strFind)
        End If
    Loop Until lngPos = 0
    CountCharacter = lngCount
End Function

[PeterPan1969]

Merci ! J'ai utilisé un peu des deux : utilisation de Len et du nombre de caractère.

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
19
20
21
22
For i = 9 To LastRow
    Cells(i, 1).HorizontalAlignment = xlRight
 
    'Pour les chapitres
    If Len(Cells(i, 1)) > 9 Then
        'Rows(39).Insert Shift:=xlDown
        Range(Cells(i, 1), Cells(i, 2)).Font.FontStyle = "Bold"
    End If
 
    'Pour les § 3.01
    If Len(Cells(i, 1)) = 4 Then
        Range(Cells(i, 1), Cells(i, 2)).Font.FontStyle = "Bold"
    End If
 
 
    'Pour les § 3.01.01.1
    If Len(Cells(i, 1)) = 9 Then
        Range(Cells(i, 1), Cells(i, 2)).Font.FontStyle = "Italic"
        Cells(i, 2).InsertIndent 2
    End If
 
Next

(Ave LastRow qui me renvoi à la dernière ligne remplie)

[Menhir]

Plus propre :

Code :

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

1
2
3
4
5
6
7
8
9
    Select Case Len(Cells(i, 1))
    Case 4
        Range(Cells(i, 1), Cells(i, 2)).Font.FontStyle = "Bold"
    Case 9
        Range(Cells(i, 1), Cells(i, 2)).Font.FontStyle = "Italic"
        Cells(i, 2).InsertIndent 2
    Case Else
        Range(Cells(i, 1), Cells(i, 2)).Font.FontStyle = "Bold"
    End Select

[mfoxy]

+1 Menhir

Je préfère largement les "Select Case" pour ce genre de condition par cas rencontré plutôt que de multiples If... End If.

[PeterPan1969]

J'avoue que je sais pas bien utiliser pas cette fonction.

Si je veux insérer une ligne sous un des cas, comment est-ce que je fais ? (avec ma boucle for, ça me met toutes les ligne directement à la première itération...)