Format cellule dans onglet

Version imprimable

Bonjour,

Pouvez vous me dire pourquoi il ne formate pas mes cellules avec le code suivant

Code:

1
2
3
sh_GlobalKrc.Range("D2:D" & sh_GlobalKrc.UsedRange.Rows.Count).Select.NumberFormat = "#.##0,00_ ;[Rouge]-#.##0,00"
        sh_GlobalKrc.Range("B2:B" & sh_GlobalKrc.UsedRange.Rows.Count).Select.WrapText = True
        sh_GlobalKrc.Range("E2:E" & sh_GlobalKrc.UsedRange.Rows.Count).Select.WrapText = True

Merci

Bonjour,
La méthode Select est à proscrire. Elle est parfaitement inutile en VBA et de plus ralenti l'exécution du programme.
Pour formater une plage complète et en supposant que la première ligne contient bien les titres et la première colonne est remplie de la première à la dernière ligne de la liste, voici un exemple qui formate la colonne 4 de la feuille nommée Feuil2 du classeur où se trouve le code VBA (ThisWorkbook)
Code:

1 2 3 4 5 6 7 8 9 10 Sub T() Dim Rng As Range Dim rng_Data As Range Set Rng = ThisWorkbook.Worksheets("Feuil2").Range("A1").CurrentRegion With Rng Set rng_Data = .Offset(1).Resize(.Rows.Count - 1) End With rng_Data.Columns(4).NumberFormat = "#,##0" Set Rng = Nothing: Set rng_Data = Nothing End Sub
Variante de la ligne 8 si tu souhaites que les valeur négatives soient en rouge entre parenthèses et sans le signe, les positives étant en bleu.

Code:

rng_Data.Columns(4).NumberFormat = "[Blue]#,##0;[Red](#,##0)"

Il y a une manière très simple de connaître la syntaxe

Tu crées le format dans une cellule quelconque (par exemple A2) et ensuite dans la fenêtre d'exécution (Ctrl G) de l'éditeur VBE, tu écris

Code:

? range("A2").NumberFormat

et tu valides par Enter et tu auras [Blue]#,##0;[Red](#,##0) qu'il te reste à Copier/Coller entre les guillemets de la propriété NumberFormat

Voici le code modifié, est ce bon?
Il coince à la ligne 12, il ne veut pas de sh_GlobalKrc PQ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub format()
    'formate sh-GlobalKrc
 
    'sh_GlobalKrc.Columns("A:O").AutoFit
        'sh_GlobalKrc.Range("D2:D" & sh_GlobalKrc.UsedRange.Rows.Count).Select.NumberFormat = "#.##0,00_ ;[Rouge]-#.##0,00"
        'sh_GlobalKrc.Range("B2:B" & sh_GlobalKrc.UsedRange.Rows.Count).Select.WrapText = True
        'sh_GlobalKrc.Range("E2:E" & sh_GlobalKrc.UsedRange.Rows.Count).Select.WrapText = True
 
    Dim Rng As Range
    Dim rng_Data As Range
 
    Set Rng = ThisWorkbook.sh_GlobalKrc.Range("A1").CurrentRegion
 
    With Rng
    Set rng_Data = .Offset(1).Resize(.Rows.Count - 1)
    End With
 
    rng_Data.Columns(4).NumberFormat = "#.##0,00_ ;[Rouge]-#.##0,00"
    rng_Data.Columns(2).WrapText = True
    rng_Data.Columns(5).WrapText = True
 
    Set Rng = Nothing: Set rng_Data = Nothing

01/12/2018, 16h50
Philippe Tulliez

Bonjour,
Je suppose que sh_GlobalKrc est soit le CodeName de la feuille soit une variable Objet. ThisWorkbook est donc superflu
En ligne 18, ce n'est pas ~~Rouge~~ mais Red

cela ne fonctionne pas

Voici mon code complet :

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Private Sub CommandButton1_Click()
 
On Error Resume Next
 
Dim chemin As String, KRCFile As String
Dim folder As Variant, box As Variant
Dim NBFichier As Integer
Dim wb As Workbook
 
 
'définit le répertoire contenant les fichiers
chemin = ThisWorkbook.Path & Application.PathSeparator
folder = "KRC_GB-BH\"
 
'tous les fichiers krc*.xlsx du folder
KRCFile = Dir(chemin & folder & "KRC" & "*.xlsx")
 
If KRCFile <> "" Then
'boucle => nombre de fichiers trouvés dans le folder
    While Not KRCFile = ""
        NBFichier = NBFichier + 1
        KRCFile = Dir
    Wend
Else: MsgBox "Not Files in the folder"
Exit Sub
End If
 
box = MsgBox("Find" & " " & NBFichier & " " & "file(s)" & " " & "?", vbYesNo + vbQuestion + vbApplicationModal + vbDefaultButton2, "")
 
KRCFile = Dir(chemin & folder & "KRC" & "*.xlsx")
 
If box = vbYes Then
    If KRCFile <> "" Then
        Application.StatusBar = "Old data erased"
        sh_GlobalKrc.Range("A2:O" & ActiveSheet.UsedRange.Rows.Count - 1).ClearContents
        MsgBox "ClearContents ok"
        Application.StatusBar = "Import in progess....."
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Do While KRCFile <> ""
            'ouvre le fichier trouvé
            Set wb = Workbooks.Open(chemin & folder & KRCFile)
            wb.Sheets("KRC").Unprotect ("1234")
            If wb.Sheets("KRC").Range("k3") = "Oui / Ja" Then
                wb.Sheets("KRC").Range("C13:N" & wb.Sheets("KRC").UsedRange.Rows.Count).Copy
                sh_GlobalKrc.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, operation _
                    :=xlNone, skipblanks:=False, Transpose:=False
                'vide le presse papier
                Call ClearClipboard
            Else
            End If
            'ferme le fichier trouvé en cours
            wb.Close False
            Set wb = Nothing
            KRCFile = Dir
        Loop
 
        MsgBox "Import OK"
        '& Application.sum("D2:D" & sh_GlobalKrc.UsedRange.Rows.Count)
 
        Application.ScreenUpdating = True
        Application.StatusBar = False
        Application.EnableEvents = True
 
        Application.Goto reference:=Range("A2")
 
        Call format
 
    End If
End If
 
End Sub
 
------------------
 
Sub format()
    'formate sh_GlobalKrc
 
    Dim Rng As Range
    Dim rng_Data As Range
 
    Set Rng = sh_GlobalKrc.Range("A1").CurrentRegion
 
    With Rng
    Set rng_Data = .Offset(1).Resize(.Rows.Count - 1)
    End With
 
    rng_Data.Columns(4).NumberFormat = "#.##0,00_ ;[Rouge]-#.##0,00"
    rng_Data.Columns(2).WrapText = True
    rng_Data.Columns(5).WrapText = True
 
    Set Rng = Nothing: Set rng_Data = Nothing
 
 
End Sub

01/12/2018, 17h21
Philippe Tulliez

Bonjour,

Citation:

cela ne fonctionne pas

Ce n'est pas une indication.
Qu'est ce-qui ne fonctionne pas ?
Le résultat attendu n'est pas au rendez-vous ou bien y a-t-il un message d'erreur si oui lequel (numéro de la ligne, numéro et texte de l'erreur)

j'ai aussi indiqué dans mon message précédent que le ligne 8 n'était pas correcte (maintenant 88) et celle-ci n'a pas été corrigée

De plus, cela sort de la question initiale car tu as ajouté le code que tu as placé dans une autre discussion publiée où tu n'as eu de réponse sans doute parce-qu'elle est mal posée ou tout simplement parce-que le code est imbuvable à lire.
J'ajouterais également que tu as placé un On Error Resume Next qui camoufle les erreurs.

Le code que j'ai posté fonctionne car je teste toutes les réponses que je publie.
01/12/2018, 17h34
rossemma

Merci pour ton aide
03/12/2018, 12h07
rossemma

Cela fonctionne mais puis-je mettre plusieurs colonnes à la suite ?

Ex : rng_Data.Columns(2).WrapText = True, mettre colonne 2 et 3 et 4.

Bonjour,

Citation:

cela fonctionne mais puis je mettre plusieurs colonnes à la suite
ex : rng_Data.Columns(2).WrapText = True
mettre colonne 2 et 3 et 4

J''ai repris mon premier exemple en y ajoutant une boucle (Ce qui a été ajouté ou modifié est en rouge)
Il y a certainement plus simple mais je n'ai pas le temps de m'y pencher
Il suffit de remplacer la propriété NumberFormat par WrapText
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub T() Dim Rng As Range Dim rng_Data As Range Dim c As Integer Set Rng = ThisWorkbook.Worksheets("Feuil2").Range("A1").CurrentRegion With Rng Set rng_Data = .Offset(1).Resize(.Rows.Count - 1) End With For c = 2 To 4 rng_Data.Columns(c).NumberFormat = "#,##0" Next Set Rng = Nothing: Set rng_Data = Nothing End Sub

03/12/2018, 13h29
rossemma

super merci
je vais adapter

Désolé une petite question

dans le code suivant, comment lui dire que les 12ères lignes ne doivent pas être prises en considération

Code:

1
2
3
4
5
6
7
8
9
Set Rng = wb.Sheets("KRC").Range("A1").CurrentRegion
 
            With Rng
            Set rng_Data = .Offset(1).Resize(.Rows.Count - 1)
            End With
 
            rng_Data.Columns(5).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00"
 
            Set Rng = Nothing: Set rng_Data = Nothing

merci

05/12/2018, 06h51
Philippe Tulliez

Bonjour,

Citation:

dans le code suivant, comment lui dire que les 12ères lignes ne doivent pas être prises en considération

L'instruction prévoyant de formater la colonne entière, il n'y a pas d'autre choix que de mettre un autre format à cette douzième ligne
Sauf s'il s'agit de tableaux de synthèses c''est curieux d'avoir dans une liste de données bien construite des formats différents dans une colonne