[E-03] - pivottable dans une macro
Bonjour à tous,
Après de longues heures de recherches infructueuses dans ce forum et sur Internet, je m'en remets à vous...
J'ai une macro qui plante avec le message d'erreur suivant :
"Run-time error 1004 : unable to set the default property of the pivotitem class".
Cette macro sert à copier x copies d'une sheet vide au départ (sorte de template) et à remplir chaque sheet générée avec les valeurs obtenues dans le pivot table de la sheet "TCD_WP".
Chaque sheet à remplir correspond à une combinaison d'un field "unit" et d'un field "niveau".
J'espère que je suis assez clair... Sinon, n'hésitez pas à demander plus d'infos... Déjà bien merci...
Un apprenti-programmeur VBA désespéré et épuisé...
Voici le code :
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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
| Sub génère_sheets_WP()
Dim Response As String
Dim dispo3(30), dispo4(30) As Double
Dim nocol(2), niv(2), nbunit(2) As Integer
For i = 1 To 23
dispo3(i) = Sheets("data").Cells(i, 7)
Next i
For i = 1 To 24
dispo4(i) = Sheets("data").Cells(i, 9)
Next i
Response = MsgBox("Faut-il effacer les sheets existantes ?", vbYesNo + vbQuestion + vbDefaultButton1, "Question")
If Response = vbYes Then
nbsh = 0
For Each ws In Worksheets
nbsh = nbsh + 1
Next ws
Application.DisplayAlerts = False
For i = 7 To nbsh
Sheets(7).Activate
' MsgBox "i = " & i & " " & Sheets(i).Name
Sheets(7).Delete
Next i
Application.DisplayAlerts = True
End If
'---------------------------------------- création des sheets
nbsh = 0
For Each ws In Worksheets
nbsh = nbsh + 1
Next ws
For i = 24 To 1 Step -1
newnom = Sheets("data").Cells(i, 4)
Sheets("sheet_vide").Select
Sheets("sheet_vide").Copy After:=Sheets(nbsh)
Sheets("sheet_vide (2)").Select
Sheets("sheet_vide (2)").Name = newnom
Next i
For i = 23 To 1 Step -1
newnom = Sheets("data").Cells(i, 3)
Sheets("sheet_vide").Select
Sheets("sheet_vide").Copy After:=Sheets(nbsh)
Sheets("sheet_vide (2)").Select
Sheets("sheet_vide (2)").Name = newnom
Next i
'----------------------------------------------- Copier/coller TCD -> Sheets
nocol(1) = 1
nocol(2) = 2
nbunit(1) = 23
nbunit(2) = 24
niv(1) = 3
niv(2) = 4
Sheets("TCD_WP").Select
MsgBox ActiveSheet.PivotTables(1).Name
For j = 1 To 2
For i = 1 To nbunit(j)
nom_unit = Sheets("data").Cells(i, nocol(j))
Sheets("TCD_WP").Select
ActiveSheet.PivotTables(1).PivotFields("Unit").CurrentPage = nom_unit
ActiveSheet.PivotTables(1).PivotFields("Niveau").CurrentPage = niv(j)
nodl = Range("A65536").End(xlUp).Row
' MsgBox nodl
nodl = nodl - 1
Rows("6:" & nodl).Select
Selection.Copy
newnom = Sheets("data").Cells(i, nocol(j) + 2)
Sheets(newnom).Select
Rows("5:5").Select
Selection.Insert Shift:=xlDown
If j = 1 Then Cells(2, 1) = "Unit " & nom_unit & " Niv. 3"
If j = 2 Then Cells(2, 1) = "Unit " & nom_unit & " Niv. 4+5"
Cells(2, 4) = nom_unit
Range("E5:N" & nodl - 1).Select
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
If nodl > 6 Then
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Rows(4).Delete
Rows(nodl - 1).Delete
Cells(1, 1).Select
Range("A" & nodl - 2 & ":C" & nodl - 2).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
For k = 4 To 15
If j = 1 Then Cells(nodl, k) = dispo3(i)
If j = 2 Then Cells(nodl, k) = dispo4(i)
Next k
Cells(1, 1).Select
Next i
Next j
End Sub |
