VBA - Mise en forme par une macro

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'ai créé une macro qui synthétise un ensemble de feuilles excel, sur une seule.

La macro marche plutôt bien mais j'ai quelques soucis.
Voici la macro :

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
96
97
98
99
100
101
102
103
104
105
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
 
'Suspension temporaires pour la macro
Application.ScreenUpdating = False
 
'Déclaration des variables
Dim TempColl() As String
Dim Test As Range
Dim ChekCell As String
Dim Cellule As Range
Dim CollNames() As String
Dim a As Integer
 
 
' ****** Programme Principal ******
a = 0
ChekCell = ""
Oldchek = ""
 
' ****** Vidage des cellules ******
 
' ==== Etape 1 : Récupérer valeurs uniques
 
If (Sh.Name <> "== RECAP ==") And (Sh.Range("F2").Value = "Liste Complète") Then
 For Each Sh In ThisWorkbook.Worksheets
  If (Sh.Name <> "== RECAP ==") And (Sh.Range("F2").Value = "Liste Complète") Then
   For Each Cellule In Sh.Range("A2:A50")
    If Not (IsError(Cellule.Value)) And (Oldchek <> Cellule.Value) Then
     If (InStr(1, ChekCell, Cellule.Value) = 0) Then
      If (a > 0) Then ChekCell = ChekCell + "-"
      'TempColl(a, 1) = Cellule.Value
      ChekCell = ChekCell + Cellule.Value
      Oldchek = Cellule.Value
      a = a + 1
     End If
    End If
   Next Cellule
  End If
 Next Sh
 
 CollNames = Split(ChekCell, "-")
 
' ==== Etape 2 : Affichage liste
 
 cc = 0
 For zz = 0 To UBound(CollNames)
  If (CollNames(zz) <> "AUTRES BANDES") And (CollNames(zz) <> "BANDES INCONNUES") Then
   Sheets("== RECAP ==").Range("A23").Offset(cc, 0).Clear
   Sheets("== RECAP ==").Range("A23").Offset(cc, 0) = CollNames(zz)
   cc = cc + 1
  End If
 Next zz
 
 Sheets("== RECAP ==").Range("A23").Offset(cc + 1, 0).Clear
 Sheets("== RECAP ==").Range("A23").Offset(cc + 1, 0) = "AUTRES BANDES"
 Sheets("== RECAP ==").Range("A23").Offset(cc + 2, 0).Clear
 Sheets("== RECAP ==").Range("A23").Offset(cc + 2, 0) = "BANDES INCONNUES"
 
' ==== Etape 3 : Tri ordre alphabétique
 
 Range("A23").Select
    ActiveWorkbook.Worksheets("== RECAP ==").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("== RECAP ==").Sort.SortFields.Add Key:=Range( _
        "A23"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("== RECAP ==").Sort
        .SetRange Range(ActiveCell, ActiveCell.Offset(UBound(CollNames) - 2, 0))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
' ==== Etape 4 : Affichage de résultats
 
 lt = UBound(CollNames) - 2
 
 For bb = 0 To lt
  Sheets("== RECAP ==").Range("B23").Offset(bb, 0).Clear
  Sheets("== RECAP ==").Range("B23").Offset(bb, 0).FormulaR1C1 = "=MultiSheets_Find(RC[-1])"
 Next bb
 
 Sheets("== RECAP ==").Range("B23").Offset(bb + 1, 0).Clear
 Sheets("== RECAP ==").Range("B23").Offset(bb + 1, 0).FormulaR1C1 = "=MultiSheets_Find(RC[-1])"
 
 Sheets("== RECAP ==").Range("B23").Offset(bb + 2, 0).Clear
 Sheets("== RECAP ==").Range("B23").Offset(bb + 2, 0).FormulaR1C1 = "=MultiSheets_Find(RC[-1])"
 
 
 Sheets("== RECAP ==").Range("A23").Offset(bb + 4, 0) = "TOTAL"
 dd = "=SUM(R[-" + CStr(bb + 4) + "]C:R[-2]C)"
 Sheets("== RECAP ==").Range("B23").Offset(bb + 4, 0).FormulaR1C1 = dd
 
 End If
 
' ==== Etape 5 : Mise en forme
 
 
 
'Réactivation pour la macro
Application.ScreenUpdating = True
 
End Sub

Cette macro donne le résultat suivant :

Pièce jointe 218032

Quelques explications sur la capture d'écran ci-dessus :
De la ligne 1 à 21 : Opérations effectuées manuellement. Saisie manuelle dans la colonne A. Résultat de formule dans la colonne B
De la ligne 23 à 38 : Opérations effectuées automatiquement par la macro ci-dessus.

Mais j'ai quelques soucis de mise en forme, sachant que la longueur du tableau peut varier :

1). On voit que certaines cellules sont toujours sélectionnées après l'execution de la macro. Comment enlever cette sélection ?
2). Je souhaiterais reproduire la mise en forme du tableau ligne 4 à 18 sur le tableau créé par la macro. Comment faire en utilisant des valeurs relatives par rapport à la cellule A23 ?
3). J'ai remarqué que si je modifie une des cellules des feuilles dans le scope de Workbook_SheetChange, le focus change de cellule. Comment l'éviter ?
4). Je voulais insérer un effacement des valeurs d'une plage de cellule (A22:B50). Mais tout ce que je suis arrivé à faire est de planter Excel. Comment faire ?

Merci d'avance pour votre aide !!!
Si vous voyez des optimisations possible sur ma macro, n'hésitez pas à m'en faire part !
Encore merci :)

17/08/2016, 09h19
Menhir
Citation:

Envoyé par fonzzie31

1). On voit que certaines cellules sont toujours sélectionnées après l'execution de la macro. Comment enlever cette sélection ?

Indique en fin de code la cellule que tu veux voir sélectionnée.
Par exemple :

Code:

Range("A1").Select

Citation:

2). Je souhaiterais reproduire la mise en forme du tableau ligne 4 à 18 sur le tableau créé par la macro. Comment faire en utilisant des valeurs relatives par rapport à la cellule A23 ?
Code:

1 2 Range("A4:B18").Copy Range("A23:B37").PasteSpecial(xlPasteFormats)
Citation:

4). Je voulais insérer un effacement des valeurs d'une plage de cellule (A22:B50). Mais tout ce que je suis arrivé à faire est de planter Excel. Comment faire ?

Code:

Range("A22:B50").ClearContents
17/08/2016, 16h14
fonzzie31

Je suis étonné que l'on ne spécifie pas la feuille qui est concernée.

Si je rajoute la feuille concernée

Code:

Worksheets("== RECAP ==").Range("A1").Select

ou

Code:

Sheets("== RECAP ==").Range("A1").Select

j'ai un message d'erreur : La méthode select de la classe Range a échoué.

Si je rajoute la feuille concernée

Code:

Worksheets("== RECAP ==").Range("A22:B50").ClearContents[/COLOR] ou [COLOR="#0000FF"]Sheets("== RECAP ==").Range("A22:B50").ClearContents

ça fait planter ma macro et Excel par la même occasion.

Pour reproduire la mise en forme du tableau à partir de la cellule A23, je ne souhaite pas prendre appui sur le modèle entre les lignes 4 et 18. Ces lignes vont, à terme, être supprimées.
17/08/2016, 18h10
Menhir

Citation:

Envoyé par fonzzie31

Je suis étonné que l'on ne spécifie pas la feuille qui est concernée.

Je t'ai donné les méthodes et propriétés à utiliser.
A toi de les adapter à ton code.

Citation:

Si je rajoute la feuille concernée Worksheets("== RECAP ==").Range("A1").Select ou Sheets("== RECAP ==").Range("A1").Select, j'ai un message d'erreur : La méthode select de la classe Range a échoué.

Est-ce que c'est le bon Workbook qui est actif ?

Citation:

Pour reproduire la mise en forme du tableau à partir de la cellule A23, je ne souhaite pas prendre appui sur le modèle entre les lignes 4 et 18. Ces lignes vont, à terme, être supprimées.

Dans ce cas, regarde les propriété Borders de l'objet Range.
https://msdn.microsoft.com/fr-fr/lib.../ff822605.aspx
17/08/2016, 18h21
fonzzie31

Oui c'est le bon workbook qui est sélectionné....