Mise en forme en fonction des groupes de caractères macro en VBA

Version imprimable

12/03/2020, 13h22
PeterPan1969

Mise en forme en fonction des groupes de caractères macro en VBA

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
12/03/2020, 13h54
Menhir

Citation:

Envoyé par PeterPan1969

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.

Citation:

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

Citation:

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.

Bonjour PeterPan,

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

Code:

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

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

Code:

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)

Plus propre :

Code:

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

13/03/2020, 13h58
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.
13/03/2020, 14h29
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...)

Bonjour,
Pour faciliter la maintenance, je modifierais la propriété FontStyle après le test

Code:

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

13/03/2020, 15h09
Menhir

Citation:

Envoyé par PeterPan1969

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...)

Cette structure Select Case est à mettre à l'intérieur de la boucle For To.
Dans ma réponse précédente, je n'ai pas repris l'intégralité de ton code, juste la partie à modifier (les If Then End If).