Discussion :

[altra]

Bonjour à toutes et à tous

J'ai utilsé l'enregistreur de macro pour mettre une mise en forme automatique, des lignes, centrer des données et ajouter un motif sur une cellule.
Je trouve que le code généré est long, je me demandais s'il n'y avait pas une manière plus élégante de coder tout ça.

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
66
67
68
69
70
71
72
73
74
75
76
77
78
 ActiveCell.FormulaR1C1 = "M"
    Range("B100").Select
    ActiveCell.FormulaR1C1 = "S"
    Range("B101").Select
    ActiveCell.FormulaR1C1 = "N"
    Range("B99:B101").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("B100").Select
    With Selection.Interior
        .ColorIndex = 0
        .Pattern = xlGray8
        .PatternColorIndex = xlAutomatic
    End With
    Range("A99:W101").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With

Merci pour votre aide,

Bonne journée

[mercatog]

Ceci suffira?

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
    Range("B99").Value = "M"
    Range("B100").Value = "S"
    Range("B101").Value = "N"
    With Range("B99:B101")
        .HorizontalAlignment = xlCenter
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
    End With
    With Range("A99:W101")
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
 
    With Range("B100").Interior
        .ColorIndex = 0
        .Pattern = xlGray8
    End With

[PMO2017]

Bonjour,

Voyez si ce code vous convient mieux

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
 
Sub aa()
Dim R As Range
Dim i&
[b99] = "M"
[b100] = "S"
[b101] = "N"
Set R = Range("B99:B101")
With R
  .HorizontalAlignment = xlCenter
  On Error Resume Next
  For i& = xlDiagonalDown To xlDiagonalUp
    .Borders(i&).LineStyle = xlNone
  Next i&
  For i& = xlEdgeLeft To xlInsideHorizontal
    With .Borders(i&)
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
  Next i&
  On Error GoTo 0
End With
With [b100].Interior
  .ColorIndex = 0
  .Pattern = xlGray8
  .PatternColorIndex = xlAutomatic
End With
Set R = Range("A99:W101")
With R
  For i& = xlDiagonalDown To xlDiagonalUp
    .Borders(i&).LineStyle = xlNone
  Next i&
  For i& = xlEdgeLeft To xlEdgeRight
    With .Borders(i&)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      .ColorIndex = xlAutomatic
    End With
  Next i&
End With
End Sub

Cordialement.

PMO
Patrick Morange

[altra]

Re

Merci pour ta proposition PMO.

J'ai juste une autre petite question.
Est ce possible d'assigner à plusieur plage la même mise en forme.
Je pensais marquer quelquechose comme ça, mais visiblement cela ne marche pas

Code :

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

1
2
3
4
5
6
Set R = Range(Cells(5, 4), Cells(7, 4))
Set R1 = Range(Cells(5, 6), Cells(7, 6))
 
With R;R1
    .Borders(xlEdgeLeft).Weight = xlThin
End With

Merci

[Krovax]

bonjour essaye

Code :

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

With union(R,R1)

je n'ai pas excel sous la main pour tester du coup je ne sas plus si c'est une , ou un ; je te laisse consulter l'aide

[Fvandermeulen]

Salut,
Dans ce cas tu peux faire:

Code :

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

1
2
3
With Range("D5:D7,F5:F7")
    .Borders(xlEdgeLeft).Weight = xlThin
End With

Par contre j'ai jamais essayé avec la "méthode" cells, à voir si c'est utile...

A+

[altra]

Merci à tous

Code :

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

union(R,R1)

me convient parfaitement


@Fvandermeulen: ta solution ne fonctionne pas chez moi.
En effet je voudrais voir apparaitre 2 lignes distinctes une de D5 à D7 et la 2nde de F7 à F5 or avec ton code il n'y a que la 1ere.
Je veux utiliser cells pour pouvoir par la suite y mettre quelquechose comme

Code :

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

1
2
Set R = Range(Cells(i, 4), Cells(i+2, 4))
Set R1 = Range(Cells(i, 6), Cells(i+2, 6))

Il semblerait qu'avec Range cela ne soit pas possible.

Merci pour votre aide.

Bonne journée

[PMO2017]

Bonjour,

La solution de Fvandermeulen fonctionne. Voici un exemple où la plage ''D5 : D7, F5 : F7'' est colorée en rouge

Code :

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

1
2
3
4
5
6
7
 
Sub bb_Fvandermeulen()
Dim R As Range
Set R = Range("D5:D7,F5:F7")
R.Interior.ColorIndex = 3
MsgBox R.Address(False, False)
End Sub

Le même résultat (mais colorisation en bleu) est obtenu avec

Code :

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

1
2
3
4
5
6
7
8
9
10
 
Sub aa_pmo()
Dim R As Range
Dim i&
i& = 5
Set R = Range(Cells(i&, 4), Cells(i& + 2, 4))
Set R = Application.Union(R, Range(Cells(i, 6), Cells(i + 2, 6)))
R.Interior.ColorIndex = 5
MsgBox R.Address(False, False)
End Sub

Cordialement.

PMO
Patrick Morange