Automatiser mise en forme cellule

Version imprimable

18/03/2014, 14h26
Feuztoff

Automatiser mise en forme cellule

bonjour,
j'ai un fichier excel dont les cellules qui le composent sont représentées ci dessous
je voudrai automatiser la mise en forme (mettre seulement en gras N°001 et augmenter sa taille)de ces cellules car il yen a des centaines
merci

une cellule contient ceci:

centre hôpital
centre sante
N°001
date 21/02/2010

Bonjour,

Une solution possible avec ce code dénombrant les caractères chr(10) "retour à la ligne" et qui met en gras les caractères compris entre les 2ème et 3ème chr(10) :

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
55
56
57
58
59
60
Sub MettreEnGrasLeNumeroDansLaCellule()
 
Dim NbChr10 As Integer
Dim J As Integer
Dim PositionPremierCaractere As Integer
Dim PositionDernierCaractere As Integer
 
Dim ShAModifier As Worksheet
Dim AireAModifier As Range
Dim CelluleAModifier As Range
Dim DerniereLigneTableau As Long
Dim ColonneAModifier As Long
Dim LigneDeTitre As Long
 
    Set ShAModifier = Sheets("Feuil1")
    LigneDeTitre = 1
    ColonneAModifier = 1
    DerniereLigneTableau = ShAModifier.Cells(ShAModifier.Rows.Count, ColonneAModifier).End(xlUp).Row
 
    With ShAModifier
            Set AireAModifier = .Range(.Cells(LigneDeTitre + 1, ColonneAModifier), .Cells(DerniereLigneTableau, ColonneAModifier))
 
            For Each CelluleAModifier In AireAModifier
 
                    NbChr10 = 0
                    PositionPremierCaractere = 0
                    PositionDernierCaractere = 0
 
                    If CelluleAModifier <> "" Then
                        For J = 1 To Len(CelluleAModifier)
 
                            If Mid(CelluleAModifier, J, 1) = Chr(10) Then
                                NbChr10 = NbChr10 + 1
                                If NbChr10 = 2 Then PositionPremierCaractere = J + 1
                                If NbChr10 = 3 Then PositionDernierCaractere = J - 1
                            End If
                        Next J
 
                        ' Au cas où il n'y aurait pas de date
                        If NbChr10 = 2 And Len(CelluleAModifier) > PositionPremierCaractere Then PositionDernierCaractere = Len(CelluleAModifier)
 
                      '  MsgBox NbChr10 & Chr(10) & PositionPremierCaractere & Chr(10) & PositionDernierCaractere
 
                        If PositionPremierCaractere > 0 And PositionDernierCaractere > 0 Then
                            With CelluleAModifier.Characters(Start:=PositionPremierCaractere, Length:=PositionDernierCaractere - PositionPremierCaractere + 1).Font
                                .Name = "Verdana"
                                .Size = 14
                                .Bold = True
                            End With
                        End If
 
                    End If
 
            Next CelluleAModifier
    End With
 
    Set AireAModifier = Nothing
    Set ShAModifier = Nothing
 
End Sub

Cordialement.

19/03/2014, 19h33
Feuztoff

Merci de la réponse
mais où je mets le code
20/03/2014, 04h01
Invité

Citation:

Envoyé par Feuztoff

mais où je mets le code

Bonjour,

Il vous faut coller cette macro dans un module standard de votre fichier (Alt-F11 pour accéder à l'éditeur VBA, puis insertion module). Il vous faut modifier également le nom de la feuille et éventuellement le numéro de la ligne de démarrage. Si vous devez sauvegarder cette macro dans le fichier, celui-ci doit être de type .xls ou .xlsm.

Cordialement.
21/03/2014, 19h41
Feuztoff

j'ai exécuté le macro mais ca marche sur une seule cellule alors que j'en ai des centaines de cellules à faire
comment procéder
22/03/2014, 04h17
Invité

Citation:

Envoyé par Feuztoff

j'ai exécuté le macro mais ca marche sur une seule cellule alors que j'en ai des centaines de cellules à faire
comment procéder

Bonjour,

Le code travaille par rapport à une colonne. Si vos données sont toutes sur une ligne, c'est logique qu'une seule cellule soit transformée. Il faudrait donc indiquer l'aire des données à modifier.

Cordialement.
27/03/2014, 19h32
Feuztoff

j'ai du mal à déterminer la plage de cellules concernée dans le code (Exemple A2--->D4)
pouvez vous m'aidez SVP
28/03/2014, 04h28
Invité

Quelle est l'aire des cellules à transformer ?

Bonjour,

Dans votre fichier, quelle est l'aire des cellules à transformer et le nom de la feuille ?

Cordialement.
16/04/2014, 07h35
Invité

Bonjour,

Vous en êtes où ?

Cordialement.
16/04/2014, 20h07
Feuztoff

Merci beaucoup, j'ai finalement trouvé
Maintenant je voudrai que le N° en gras soit mis automatiquement et incrémenté par 1 dans le sens horizontal sur une plage de 700 cellules (ex. A1:D170)
merci encore
17/04/2014, 06h14
Invité

Bonjour,

Pour toute nouvelle demande, faites un nouveau message.

Cordialement.