Mise en page sur excel grâce à VBA

**fabien32200** · 27/04/2016, 09h35

J’utilise ce code pour la mise en page de ma feuille :

Code :

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

1
2
3
Sub PartieTexte()
      Range("A:I").Characters(20, 13).Font.Size = 13
End Sub

Mais j’aimerai rajouter dans ce code : le fait que la colonne D ait une largeur de 32 et que la colonne E ait une largeur de 28.

De plus, il existe un code pour que les chiffres, présents dans la colonne H, qui sont <0 soient remplis en couleur rouge ?

**Philippe PONS** · 27/04/2016, 09h50

Salut,

pour les colonnes

Code :

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

1
2
 
Columns("D:D").ColumnWidth=32

**fabien32200** · 27/04/2016, 10h02

Ok parfait, merci .

J'ai utilisé ceci pour ma mise en page :

Code :

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

1
2
3
4
5
6
7
8
9
Sub PartieTexte()
      Range("A:I").Font.Size = 10
      Columns("A:A").ColumnWidth = 10.4
      Columns("B:B").ColumnWidth = 32
      Columns("D:D").ColumnWidth = 27
      Columns("E:E").ColumnWidth = 23
      Columns("J:J").ColumnWidth = 17
 
End Sub

C'est très pratique.

Comment faire pour que les chiffres, présents dans la colonne H et qui sont <0, soient remplis en rouge ?

**halaster08** · 27/04/2016, 10h23

Bonjour,

Connais tu l'enregistreur de macro?
Si non il y a un tres bon tutoriel sur ce site.
Le principe est simple tu active l'enregistreur, tu fais ce que tu veux (ici un format conditionel) puis tu ferme l'enregistreur et récupère le code.
Ca devrais te permettre de récuperer le code que tu souhaites

**fabien32200** · 27/04/2016, 10h30

@halaster08, oui je connais l'enregistreur macro.

Cependant avec cet enregistreur, je ne parviendrais pas à faire ce que je souhaite.

Lorsque j'importe mes données les valeurs présentes dans ma colonne H varient. Par conséquent le code issue de l'enregistreur de macro ne sera plus bon.

**RyuAutodidacte** · 27/04/2016, 10h37

Bonjour,
juste une MFC (mise en forme coditionnelle).
tu peux la faire avec l'enregistreur de macro mais est ce bien utile ??

PS : @joe.levrai t'as proposé une solution dans ton précédent post, pour que tu es vraiment un fichier au top concernant l'utilisation de formule, pour plus de simplicité et de robutesse au niveau du résultat, je ne sais pas si tu compte lui répondre
mais sache que chaque personne du forum qui t'aide, prennent de leur temps bénévolement pour aider. Donc si tu réponds c'est bien, dans le cas contraire il serait bien que tu indiques ton post résolu, afin de ne pas faire perdre leur temps.
Certes le temps est donné gratuit, mais il est aussi précieux, et permet d'aider d'autres personnes qui en ont besoin

**fabien32200** · 27/04/2016, 10h44

Je viens de répondre sur ce post à l'instant. Je pensais avoir répondu, plutôt ce matin, mais ce n'était pas le cas.

Je vais essayé de trouver une solution.

Merci

**halaster08** · 27/04/2016, 10h47

Envoyé par fabien32200;8613674
Cependant avec cet enregistreur, je ne parviendrais pas à faire ce que je souhaite.

[B

Lorsque j'importe mes données les valeurs présentes dans ma colonne H varient[/B]. Par conséquent le code issue de l'enregistreur de macro ne sera plus bon.

Logiquement puisque tu test si valeur<0 même si les valeurs changent la MFC devrait marcher quand même.
De plus un code donné par l'enregistreur de macro sa s'adapte, il faut rarement l'utiliser tel quel.
Si tu poste le code donner par l'enregistreur ici je suis qu'on pourra t'aider à l'adapter.

**RyuAutodidacte** · 27/04/2016, 10h49

Envoyé par fabien32200

@halaster08, oui je connais l'enregistreur macro.

Cependant avec cet enregistreur, je ne parviendrais pas à faire ce que je souhaite.

Lorsque j'importe mes données les valeurs présentes dans ma colonne H varient. Par conséquent le code issue de l'enregistreur de macro ne sera plus bon.

Rappel toi de ton précédent post ou je t' ai indiqué comment obtenir la dernière ligne avec DerL_ColF avec ça je pense que tu peux t'en sortir

**fabien32200** · 27/04/2016, 11h46

Tout à fait RyuAutodidacte.

Probèle résolu. Merci à tous

J'ai une petite question à vous poser :

J'utilise ce code afin d'importer certaines données vers mon classeur excel ouvert :

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
Sub Importer()

    Dim Chemin As String, Fichier As String, Fichier2 As String

    '
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    Dim shTo As Worksheet
    Dim varTab As Variant
    '
    '
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fichier = Dir("C:\Users\fetche\Desktop\perf automatisaiton fabien.xlsx")

    ' pointeurs
    Set wkb = Workbooks.Open(Chemin & Fichier)
    Set shFrom = wkb.Worksheets("Feuil1")
    Set shTo = ThisWorkbook.Worksheets("DG_ANALYSE")

    Application.ScreenUpdating = False

'    With Workbooks.Open(Chemin & Fichier)
'    Range("A2").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlToRight)).Select
'    Selection.Copy
'    ThisWorkbook.ActiveSheet.Range("K1").PasteSpecial Paste:=xlPasteValues
'    .Close savechanges:=False
'    End With

    varTab = shFrom.Range(shFrom.Range("A1"), shFrom.Range("A1").End(xlDown))
    shTo.Range("K1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab

    varTab = shFrom.Range(shFrom.Range("B1"), shFrom.Range("B1").End(xlDown))
    shTo.Range("L1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab

End Sub

Je souhaiterai que le fichier, où je prends les données, ne soit non plus enregistré en "C:\" mais en "R:\" afin qu'un collègue puisse pouvoir y accéder.
Cependant dès que j'enregistre ce fichier en "R:\", je change ainsi l'adresse dans le code ci-dessus, ma macro ne fonctionne plus.

A quoi cela est du ?

**RyuAutodidacte** · 27/04/2016, 11h56

Re,

pas le temps de répondre à ta dernière question mais pour infos :
en allant dans la faq (que tu n'utilises pas assez ou pas du tout à mon avis) voilà ce que tu aurais pu avoir, tous les détails voulus : http://silkyroad.developpez.com/Exce...itionnelle/#LV
et ce que tu aurais pu faire juste en modifiant le résultat de l'enregistreur de macro :

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
Sub Macro1()
Dim DerL_ColH As Long
 
DerL_ColH = Feuil1.Range("H" & Rows.Count).End(xlUp).Row
 
    With Feuil1.Range("H2:H" & DerL_ColH)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
            Formula1:="=0"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .ColorIndex = 2
            .Bold = True
            .Italic = False
        End With
        With .FormatConditions(1).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ColorIndex = 3
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
End Sub

comme tu peux le voir j'ai banni les Selection (éviter le plus souvent : Select, Selection, … il me semble en avoir oublié un)

J'ai rajouté en plus :

Code :

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

.FormatConditions.Delete

pour eviter d'entasser les MFC

**halaster08** · 27/04/2016, 11h58

Je suis pas expert mais je suppose que c'est ici que ça plante "Workbooks.Open(Chemin & Fichier)" ?
Dans chemin tu as thisworkbook.path donc qqchose avec c:\ ou r:\
Dans fichier tu as remis un C:\
Donc tu retrouves au final avec deux c:\ dans ton adresse.
Pour en être sur rajoute juste avant cette ligne la commande "debug.print Chemin & Fichier" pour voir ce si le chemin

**fabien32200** · 27/04/2016, 12h02

@RyuAutodidacte, Pour la mise en forme conditionnelle j'ai (enfin) réussi à trouver quelque chose qui marche (le code n'est pas très beau mais il marche) :

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
55
56
57
58
59
60
61
62
63
64
65
Sub Fabien()
 
    Range("H3:H974").Select
    ActiveWindow.SmallScroll Down:=-15
    Cells.FormatConditions.Delete
    Range("H3:H1000").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueNumber
    Selection.FormatConditions(1).ColorScaleCriteria(1).Value = -3
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValueNumber
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 0
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueNumber
    Selection.FormatConditions(1).ColorScaleCriteria(3).Value = 3
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 5287936
        .TintAndShade = 0
    End With
    Range("I26").Select
    ActiveWindow.SmallScroll Down:=132
    ActiveWindow.ScrollRow = 131
    ActiveWindow.ScrollRow = 126
    ActiveWindow.ScrollRow = 121
    ActiveWindow.ScrollRow = 117
    ActiveWindow.ScrollRow = 107
    ActiveWindow.ScrollRow = 97
    ActiveWindow.ScrollRow = 87
    ActiveWindow.ScrollRow = 75
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 1
    Range("B1").Select
 
End Sub
 
 
Sub PartieTexte()
      Range("A:L").Font.Size = 10
      Columns("A:A").ColumnWidth = 10.4
      Columns("B:B").ColumnWidth = 32
      Columns("D:D").ColumnWidth = 27
      Columns("E:E").ColumnWidth = 23
      Columns("I:I").ColumnWidth = 17
      Columns("K:K").ColumnWidth = 30
      Columns("L:L").ColumnWidth = 19
 
 
End Sub

Mon souci maintenant c'est que je souhaiterai que le fichier, où je prends les données, ne soit non plus enregistré en "C:\" mais en "R:\" afin qu'un collègue puisse pouvoir y accéder. Mais lorsque je change "C:\" en "R:\, le code ci-dessous marche plus.

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
Sub Importer()
 
    Dim Chemin As String, Fichier As String, Fichier2 As String
 
    '
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    Dim shTo As Worksheet
    Dim varTab As Variant
    '
    '
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fichier = Dir("C:\Users\fetche\Desktop\perf automatisaiton fabien.xlsx")
 
    ' pointeurs
    Set wkb = Workbooks.Open(Chemin & Fichier)
    Set shFrom = wkb.Worksheets("Feuil1")
    Set shTo = ThisWorkbook.Worksheets("DG_ANALYSE")
 
    Application.ScreenUpdating = False
 
'    With Workbooks.Open(Chemin & Fichier)
'    Range("A2").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlToRight)).Select
'    Selection.Copy
'    ThisWorkbook.ActiveSheet.Range("K1").PasteSpecial Paste:=xlPasteValues
'    .Close savechanges:=False
'    End With
 
    varTab = shFrom.Range(shFrom.Range("A1"), shFrom.Range("A1").End(xlDown))
    shTo.Range("K1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("B1"), shFrom.Range("B1").End(xlDown))
    shTo.Range("L1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
End Sub

Ok halaster08, je vais tester ça.

**Philippe PONS** · 27/04/2016, 12h16

Attention, le fonction Dir ne permet que de vérifier qu'un fichier existe bien.
Si tu change C en R dans cette fonction et que le fichier n'existe pas dans R, Dir retourne une chaine vide!
A vérifier!

Et dans ton code , je ne vois pas d'instruction pour enregistrer le classeur!

**fabien32200** · 27/04/2016, 13h08

Cette instruction pour enregistrer le classeur me permettrait de faire quoi ?

**Philippe PONS** · 27/04/2016, 13h39

Code :

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

1
2
3
4
5
6
 
' ThisWorkbook.Path renvoi le répertoire ou se trouve le classeur dans lequel tourne le programme.
Chemin = ThisWorkbook.Path & Application.PathSeparator
 
' et cette instruction ouvre un classeur sensé se trouver dans le même répertoire.
Set wkb = Workbooks.Open(Chemin & Fichier)

Pour ouvrir le classeur "C:\Users\fetcheberry\Desktop\perf automatisaiton fabien.xlsx"
en s'assurant que e fichier existe bien:

Code :

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

1
2
3
4
5
 
 
If Dir("C:\Users\fetcheberry\Desktop\perf automatisaiton fabien.xlsx") <> "" Then
  Set wkb = Workbooks.Open("C:\Users\fetcheberry\Desktop\perf automatisaiton fabien.xlsx")
End If

**fabien32200** · 27/04/2016, 13h59

J'ai essayé :

Code :

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

1
2
3
4
 
If Dir("C:\Users\fetcheberry\Desktop\perf automatisaiton fabien.xlsx") <> "" Then
  Set wkb = Workbooks.Open("C:\Users\fetcheberry\Desktop\perf automatisaiton fabien.xlsx")
End If

Mais ça ne marche pas lorsque le fichier est enregistré sur R.

Ce code marche lorsque le fichier est enregistré sur C :

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
Sub Importer()
 
    Dim Chemin As String, Fichier As String, Fichier2 As String
 
    '
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    Dim shTo As Worksheet
    Dim varTab As Variant
    '
    '
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fichier = Dir("C:\Users\fetcheberry\Desktop\perf automatisaiton fabien.xlsx")
 
    ' pointeurs
    Set wkb = Workbooks.Open(Chemin & Fichier)
    Set shFrom = wkb.Worksheets("Feuil1")
    Set shTo = ThisWorkbook.Worksheets("DG_ANALYSE")
 
    Application.ScreenUpdating = False
 
'    With Workbooks.Open(Chemin & Fichier)
'    Range("A2").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlToRight)).Select
'    Selection.Copy
'    ThisWorkbook.ActiveSheet.Range("K1").PasteSpecial Paste:=xlPasteValues
'    .Close savechanges:=False
'    End With
 
    varTab = shFrom.Range(shFrom.Range("A1"), shFrom.Range("A1").End(xlDown))
    shTo.Range("K1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("B1"), shFrom.Range("B1").End(xlDown))
    shTo.Range("L1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
End Sub

Mais dès que je tente d'importer des données sur "R" ça ne marche plus (pourtant le fichier est bien enregistré sur R) :

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
Sub Importer()
 
    Dim Chemin As String, Fichier As String, Fichier2 As String
 
    '
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    Dim shTo As Worksheet
    Dim varTab As Variant
    '
    '
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fichier = Dir("R:\xxxx\xxxx\xxxxx\perf automatisaiton fabien.xlsx")
 
    ' pointeurs
    Set wkb = Workbooks.Open(Chemin & Fichier)
    Set shFrom = wkb.Worksheets("Feuil1")
    Set shTo = ThisWorkbook.Worksheets("DG_ANALYSE")
 
    Application.ScreenUpdating = False
 
'    With Workbooks.Open(Chemin & Fichier)
'    Range("A2").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlToRight)).Select
'    Selection.Copy
'    ThisWorkbook.ActiveSheet.Range("K1").PasteSpecial Paste:=xlPasteValues
'    .Close savechanges:=False
'    End With
 
    varTab = shFrom.Range(shFrom.Range("A1"), shFrom.Range("A1").End(xlDown))
    shTo.Range("K1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("B1"), shFrom.Range("B1").End(xlDown))
    shTo.Range("L1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
End Sub

**Philippe PONS** · 27/04/2016, 14h12

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
 
 
Sub Importer()
 
    Dim Chemin As String, Fichier As String, Fichier2 As String
 
    '
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    Dim shTo As Worksheet
    Dim varTab As Variant
    '
    ' la tu peux mettre le nom du disk que tu veux, c: ou r:
    Chemin = "R:\Users\fetcheberry\Desktop\" ' attention: ici j'ai mis le PathSeparator dans la chaine!!
    Fichier = "perf automatisaiton fabien.xlsx"
 
    ' si le fichier existe bien...
    If Dir(Chemin & Fichier) <> "" Then
    ' alors on ouvre le classeur
      Set wkb = Workbooks.Open(Chemin & Fichier)
    End If
 
    ' pointeurs
    Set shFrom = wkb.Worksheets("Feuil1")
    Set shTo = ThisWorkbook.Worksheets("DG_ANALYSE")
 
    Application.ScreenUpdating = False
 
 
    varTab = shFrom.Range(shFrom.Range("A1"), shFrom.Range("A1").End(xlDown))
    shTo.Range("K1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
    varTab = shFrom.Range(shFrom.Range("B1"), shFrom.Range("B1").End(xlDown))
    shTo.Range("L1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
 
End Sub

**fabien32200** · 27/04/2016, 14h41

Super Philippe Pons, ton code marche !

merci

**Philippe PONS** · 27/04/2016, 14h44

Parfait! Bonne suite...

Mise en page sur excel grâce à VBA

Macros et VBA Excel

Discussions similaires

Partager

Partager