Discussion :

[WagaSeb]

Rebonjour,

Ma macro fonctionne bien sur mon PC et pas sur d'autres ?
Je ne comprend pas car je ne crois pas avoir chargé de modules ...
Quelqu'un peut 'il me donner des pistes ?

Merci d'avance (et désolé pour mes questions un peu neuneu ...)

[Invité]

Bonjour

Tu dis qu'elle ne fonctionne pas, mais quoi ?

- Elle bugue (si oui où avec le code)
- Elle ne se lance pas ?
- Même versions d'Excel ?

Starec

[WagaSeb]

Désolé d'avoir été un peu long, mais j'étais absent.

Effectivement les versions sont différentes: Macros réalisées sous Office Pro Edition 2003 et elle doit tourner sur un poste équipé avec Small business edition 2003

Sinon, oui la macro se lance mais bloque sur une ligne de code. Mais je ne m'en souviens pas et je n'ai pas accès au PC concerné pour l'instant ...

Bref, je ne fais pas beaucoup avancer le chmilblick ...
Merci quand meme !!!

[helios77]

Que fait ta macro grosso modo

Par exemple, sous office 2003, la commande Replace pour remplacerdes caractères par d'autres existent mais pas sous 2000 ==> plantage

[WagaSeb]

Hello,

Que fait ma macro ? Elle va chercher des infos dans le classeur, créée des tableaux selon la personne recherchée, et créée ensuite un mini tableau et un minigraph associé à l'étude

Voici le code : (n'hésitez pas à me faire des remarques !!)

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
Public NamEtud() As Integer 'Tableau contenant toutes les études correpndant au CE recherché
 
Sub Yahoo()
Call ClearAll
Application.ScreenUpdating = False
Dim pl As Integer   'Correspond au numéro de tableau en cours
Dim PlMax As Integer    'Correspond au Nbre max d'études
 
Call CherchEtud
For pl = 1 To NamEtud(0)     'Défini le nombre de tableaux
 
x = Placement(pl)       'Recherche la cellule en haut/gauchedu tableau N° Pl
Call Tableau(x, 5)      'Ecris le tableau N° Pl
Call Misenforme(x, 5)   'Mise ne forme du tableau N° Pl
Call Minigraph(pl)
Next pl
 
'Worksheets("Bilan").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
 
 
Application.ScreenUpdating = True
End Sub
 
Sub CherchEtud()
Dim ChargEtude As String 'Défini le CE recherché
'Dim NamEtud() As Integer 'Tableau contenant toutes les études correpndant au CE recherché
Dim n As Integer 'Défini le n° de rang dans le tableau
 
'Initialisation
n = 0
ReDim NamEtud(n)
ChargEtude = CStr(Worksheets("cachée").Cells(15 + Worksheets("cachée").Cells(8, 2).Value#, 1).Value)
 
'Vérifie si c'est le bon CE
For NbLigne = 7 To Worksheets("Synthèse").Cells(7, 2).End(xlDown).Row
        'Si oui, on l'enregistre dans le tableau
        If CStr(Worksheets("Synthèse").Cells(NbLigne, 2).Value) = ChargEtude Then
            n = n + 1
            ReDim Preserve NamEtud(n)
            NamEtud(n) = Worksheets("Synthèse").Cells(NbLigne, 1).Value
End If
 
Next NbLigne
NamEtud(0) = UBound(NamEtud, 1) 'Place le nombre de valeur du tableau en début de tableau
 
 
 
 
End Sub
 
Sub ClearAll()
'Réinitialisation de la feuille
Dim Plage As Range
Dim Max As Integer
Max = Worksheets("Bilan").Cells(65000, 6).End(xlUp).Row
 
Set Plage = Range("A16", "F" & Max)
 
With Plage
    .Value = ""
    .Interior.ColorIndex = 33
    .Font.ColorIndex = 0
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
ActiveSheet.ChartObjects.Delete
End Sub

et voici les fonctions associées :

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Option Explicit
 
Function Placement(pl)
'Place le tableau au bon endroit selon le nombre de tableaux
If pl = 1 Then
Placement = 16
Else
Placement = pl * 12 + 4
End If
End Function
 
Function Tableau(x, y)
Dim MonTableau(10, 1) As String
 
'Place les valeurs/formules dans le tableau "MonTableau"
MonTableau(0, 0) = "N° d'étude :"
MonTableau(0, 1) = NamEtud((x - 4) / 12)
MonTableau(1, 0) = ""
MonTableau(1, 1) = ""
MonTableau(2, 0) = "Coût horaire :"
MonTableau(2, 1) = "=Cachée!R9C3"
MonTableau(3, 0) = "Budget de l'étude :"
MonTableau(3, 1) = "=IF(ISERROR(VLOOKUP(R[-3]C,'Liste affaires'!R[-17]C[-4]:R[969]C[2],7,FALSE)*9),""Non connu"",VLOOKUP(R[-3]C,'Liste affaires'!R[-17]C[-4]:R[969]C[2],7,FALSE))"
MonTableau(4, 0) = "Nbre d'heures prévues :"
MonTableau(4, 1) = 10
MonTableau(5, 0) = "Montant des achats :"
MonTableau(5, 1) = "=SUM(IF(ISERROR(VLOOKUP(R[-5]C,'Liste affaires'!R[-19]C[-4]:R[967]C[8],12,FALSE)),0,VLOOKUP(R[-5]C,'Liste affaires'!R[-19]C[-4]:R[967]C[8],12,FALSE)),IF(ISERROR(VLOOKUP(R[-5]C,'Liste affaires'!R[-19]C[-4]:R[967]C[8],13,FALSE)),0,VLOOKUP(R[-5]C,'Liste affaires'!R[-19]C[-4]:R[967]C[8],13,FALSE)))"
MonTableau(6, 0) = "Valorisation des heures :"
MonTableau(6, 1) = "=R[-4]C*R[2]C"
MonTableau(7, 0) = "Nombre d'heures passées :"
MonTableau(7, 1) = "=GETPIVOTDATA(""Heures"",'TCD Global'!R[-17]C[-4],""Salarié"",Cachée!R100C3,""N° affaire"",R[-7]C6)"
 
MonTableau(8, 0) = "Bilan des heures :"
MonTableau(8, 1) = "=R[-4]C-R[-1]C"
MonTableau(9, 0) = "Résultat :"
MonTableau(9, 1) = "=R[-6]C-(R[-3]C+R[-4]C)"
 
'Place "MonTableau sur la feuille
With Cells(x, y)
    .Offset(0, 0).Value = MonTableau(0, 0)
    .Offset(0, 1).Value = MonTableau(0, 1)
    .Offset(1, 0).Value = MonTableau(1, 0)
    .Offset(1, 1).Value = MonTableau(1, 1)
    .Offset(2, 0).Value = MonTableau(2, 0)
    .Offset(2, 1).Value = MonTableau(2, 1)
    .Offset(3, 0).Value = MonTableau(3, 0)
    .Offset(3, 1).Value = MonTableau(3, 1)
    .Offset(4, 0).Value = CStr(MonTableau(4, 0))
    .Offset(4, 1).FormulaR1C1 = MonTableau(4, 1)
    .Offset(5, 0).Value = MonTableau(5, 0)
    .Offset(5, 1).Value = MonTableau(5, 1)
    .Offset(6, 0).Value = MonTableau(6, 0)
    .Offset(6, 1).Value = MonTableau(6, 1)
    .Offset(7, 0).Value = MonTableau(7, 0)
    .Offset(7, 1).Value = MonTableau(7, 1)
    .Offset(8, 0).Value = MonTableau(8, 0)
    .Offset(8, 1).FormulaR1C1 = MonTableau(8, 1)
    .Offset(9, 0).Value = MonTableau(9, 0)
    .Offset(9, 1).FormulaR1C1 = MonTableau(9, 1)
 
End With
End Function
 
Function Misenforme(x, y)
 
'Mise en forme du centre du tableau
With Range(Cells(x, y), Cells(x + 9, y + 1))
    .Interior.Color = 33
    .Font.ColorIndex = 2
End With
 
'Mise en forme de l'entete du tableau
With Range(Cells(x + 1, y), Cells(x + 9, y + 1))
    .Interior.ColorIndex = 34
    .Font.ColorIndex = 1
End With
 
'Créer cadre sur tout le tableau
With Range(Cells(x, y), Cells(x + 9, y + 1))
    .BorderAround ColorIndex:=1, Weight:=xlThin
 
End With
End Function
 
Function Protection(x)
 
'Protection de la zone
With Range(Cells(x, 5), Cells(x + 9, 6))
    .Locked = False
    .FormulaHidden = True
End With
End Function

et maintenant le code pour les graphiques :

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
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
Sub Minigraph(pl)
Dim LinMiniTab As Double
Dim BudPrev As Double
Dim BudReel As Double
Dim TpsPrev As Double
Dim TpsReel As Double
LinMiniTab = 12 * pl + 4
 
'Données fixes :
Cells(LinMiniTab + 3, 2) = "Budget :"
Cells(LinMiniTab + 4, 2) = "Temps :"
Cells(LinMiniTab + 2, 3) = "Prévu :"
Cells(LinMiniTab + 2, 4) = "Réel :"
 
'Données variables :
Cells(LinMiniTab + 3, 3) = Cells(LinMiniTab + 3, 6).Value
Cells(LinMiniTab + 3, 4) = Cells(LinMiniTab + 9, 6).Value
Cells(LinMiniTab + 4, 3) = Cells(LinMiniTab + 4, 6).Value
Cells(LinMiniTab + 4, 4) = Cells(LinMiniTab + 7, 6).Value
 
Cells(LinMiniTab + 3, 3).FormulaR1C1 = "=RC[3]"
Cells(LinMiniTab + 3, 4).FormulaR1C1 = "=R[6]C[2]"
Cells(LinMiniTab + 4, 3).FormulaR1C1 = "=RC[3]"
Cells(LinMiniTab + 4, 4).FormulaR1C1 = "=R[3]C[2]"
 
 
 
'Création du minigraph
Charts.Add
ActiveChart.Location _
    Where:=xlLocationAsObject, Name:="Bilan"
 
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheets("Bilan").Range("B18:B19"), PlotBy _
        :=xlRows
    ActiveChart.SeriesCollection(1).Delete
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).XValues = "=Bilan!R18C3:R18C4"
    ActiveChart.SeriesCollection(1).Values = "=Bilan!R19C3:R19C4"
    ActiveChart.SeriesCollection(1).Name = "=Bilan!R19C2"
    ActiveChart.SeriesCollection(2).XValues = "=Bilan!R18C3:R18C4"
    ActiveChart.SeriesCollection(2).Values = "=Bilan!R20C3:R20C4"
    ActiveChart.SeriesCollection(2).Name = "=Bilan!R20C2"
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Bilan"
 
 
 
 
With ActiveChart
    .SetSourceData Range("B" & pl * 12 + 6 & ":D" & pl * 12 + 8)
    .HasTitle = False
    .ChartType = xlColumnClustered
    .HasLegend = True
    .Axes(xlCategory).TickLabels.Orientation = xlHorizontal
    .PlotArea.Top = 0
    .PlotArea.Top = 100
    .PlotArea.Height = 300
    .Axes(xlValue).MaximumScaleIsAuto = True
    .HasDataTable = Worksheets("Bilan").TableBox.Value
End With
 
 
'Placement/Dimensionnement du minigraph
ActiveSheet.ChartObjects(ActiveChart.Parent.Name).Name = "Graph" & pl
 
With ActiveSheet.ChartObjects("Graph" & pl)
.Left = Range("B" & pl).Left
.Top = Range("B" & (12 * pl + 4)).Top
.Width = Range("B" & (12 * pl + 4) & ":D" & (12 * pl + 13)).Width
.Height = Range("B" & (12 * pl + 4) & ":D" & (12 * pl + 13)).Height
End With
 
'Formatage du minigraph
ActiveChart.PlotArea.Select
    Selection.Top = 1
    Selection.Left = 1
    Selection.Height = 194
    Selection.Width = 350
 
With ActiveChart
    .SeriesCollection(1).AxisGroup = 2
    .Axes(xlValue).Select
    .Axes(xlValue).TickLabels.Font.Size = 7
    '.Axes(xlCategory).TickLabels.Font.Size = 3
    .Legend.Select
End With
 
    Selection.Left = 140
    Selection.Top = 1
 
With ActiveChart
    .SeriesCollection(2).AxisGroup = 1
    .Axes(xlValue).Select
    .Axes(xlValue).TickLabels.Font.Size = 7
    '.Axes(xlCategory).TickLabels.Font.Size = 7
End With
 
'Coloration conditionnelle
 
If Worksheets("Bilan").Colorbox.Value = True Then
 
BudReel = Worksheets("Bilan").Cells(19, 4).Value
BudPrev = ThisWorkbook.Worksheets("Bilan").Cells(19, 3).Value
TpsPrev = ThisWorkbook.Worksheets("Bilan").Cells(20, 3).Value
TpsReel = ThisWorkbook.Worksheets("Bilan").Cells(20, 4).Value
 
ActiveChart.SeriesCollection(1).Select
 
 
 
Select Case BudReel
 
        Case Is > BudPrev
        ActiveChart.SeriesCollection(1).Select
        With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
        End With
 
        Case Is > BudPrev - BudPrev * 20 / 100
        ActiveChart.SeriesCollection(1).Select
        With Selection.Interior
        .ColorIndex = 46
        .Pattern = xlSolid
        End With
 
        Case Is < BudPrev
        ActiveChart.SeriesCollection(1).Select
        With Selection.Interior
        .ColorIndex = 50
        .Pattern = xlSolid
        End With
 
End Select
 
 
 
Select Case TpsReel
 
        Case Is > TpsPrev
        ActiveChart.SeriesCollection(2).Select
        Selection.Fill.Patterned Pattern:=msoPattern30Percent
    With Selection
        .Fill.Visible = True
        .Fill.ForeColor.SchemeColor = 3
        .Fill.BackColor.SchemeColor = 2
    End With
 
        Case Is > TpsPrev - TpsPrev * 20 / 100
        ActiveChart.SeriesCollection(2).Select
        Selection.Fill.Patterned Pattern:=msoPattern30Percent
    With Selection
        .Fill.Visible = True
        .Fill.ForeColor.SchemeColor = 46
        .Fill.BackColor.SchemeColor = 2
    End With
 
        Case Is < TpsPrev
        ActiveChart.SeriesCollection(2).Select
        Selection.Fill.Patterned Pattern:=msoPattern30Percent
    With Selection
        .Fill.Visible = True
        .Fill.ForeColor.SchemeColor = 50
        .Fill.BackColor.SchemeColor = 2
    End With
 
End Select
 
Else
 
 
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 33
.Pattern = xlSolid
ActiveChart.SeriesCollection(2).Select
End With
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
End If
Range("K10").Select
 
End Sub

Bon courage si vous lisez tout ...
Seb

[Invité]

Re

Pour ma culture qu'est-ce que : Small business edition 2003
Et quelle est la différence avec l'office ?

Starec

[WagaSeb]

C'est un office mais c'est juste la version d'office qui contient :
-Word
-Excel
-Powerpoint
- et publisher je crois
En fait je crois que c'est ce que l'on appelle couremment Office PME

Pour info très sommaire :
http://www.microsoft.com/belux/fr/sm...be/detail.mspx

[helios77]

Bonjour

j'ai u un Value# dans tes macros, c'est normal??
Ca fait quoi ????


SIonon, le plus simple serrait de savoir sur quelle ligne çà palnte

[WagaSeb]

Effectivement le value# n'était pas normal !! Merci
Bizard que ca marche sur mon PC
Sinon, je vais essayer de retourner sur le PC en question, j'en saurais un peu plus (mais possible qu'a partir de demain ...)

Sinon, j'ai pas fais de trop grosses betises ds mon code (ca fait seulment qq mois que je me suis mis à VBA...)
En tout cas merci !!