Discussion :

[batou.c]

Bonjour,

Je rencontre un problème d'exécution de macro sous Excel 2010.
Cette macro fonctionne sous Excel 2007.
Il n'y a pas de msg d'erreur, plantage brutal d'Excel.
J'ai vérifié les réferences, les différences :
- Microsoft Excel 12.0 Object library / Microsoft Excel 14.0 Object library
- Microsoft Office 12.0 Object library / Microsoft Office 14.0 Object library

Environnement :
Windows 7
VB 6.3

Merci

[EngueEngue]

Tu nous montre le bébé ?

[batou.c]

Voila la bête, je précise que je fais une reprise d'un existant :

"

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
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
Option Explicit
 
'25-IX-2008:
Private Sub cmdGrupos_Click()
    On Error GoTo 0
 
    Application.ScreenUpdating = False
    Dim ModeRecalcul As Long
    ModeRecalcul = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    'Purge existing data
    shtGrupos.Range("A3:L65000").ClearContents
    'Session Manager declaration
    Dim SessionManager As SessionMgr, Sess As SessionMgr
    'Enterprise Session declaration
    Dim esession As EnterpriseSession
    'InfoStore declaration
    Dim IStore As InfoStore
    'Grupos.
    Dim MisGrupos As InfoObjects
    Dim MiGrupo As InfoObject
    'Usuarios.
    Dim MisUsuarios As InfoObjects
    Dim strUsuarios As String
    Dim lngUsuario As Long
 
    Dim Rng As Excel.Range
    Dim RowNum As Long
    Dim ErrorState As String
    'Dim test
 
    'Session Manager instanciation
    Set SessionManager = CreateObject("CrystalEnterprise.SessionMgr")
    'Enterprise Session instanciation
    Set esession = SessionManager.Logon(DameUserName(), DamePassword(), DameCMS(), "secEnterprise")
    'Infostore instanciation
    Set IStore = esession.Service("", "InfoStore")
    'document the reports
    Set MisGrupos = IStore.Query( _
        "SELECT TOP 1000000 SI_ID, SI_NAME, SI_DESCRIPTION, SI_GROUP_MEMBERS FROM CI_SYSTEMOBJECTS " & _
        "Where SI_KIND='UserGroup' ORDER BY SI_NAME")
 
    RowNum = 2
    Set Rng = shtGrupos.Cells
    'Write in the top the server/login used, the update date
    Rng(1, 2) = Date & " " & Time
 
    For Each MiGrupo In MisGrupos
        RowNum = RowNum + 1
        Rng(RowNum, 1) = MiGrupo.ID
        Rng(RowNum, 2) = MiGrupo.Title
        Rng(RowNum, 3) = MiGrupo.Description
        Rng(RowNum, 5) = "INFORMATIQUE"
        Rng(RowNum, 6) = "DSI"
 
        'recherche Infocentre et Carmi concernée
        Call initinfo(MiGrupo, Rng, RowNum)
        'Buscar los usuarios de este grupo.
        strUsuarios = ""
 
        If MiGrupo.PluginInterface.Users.Count > 0 Then
            For lngUsuario = 1 To MiGrupo.PluginInterface.Users.Count
                If lngUsuario = 1 Then
                    strUsuarios = CStr(MiGrupo.PluginInterface.Users(lngUsuario))
                Else
                    strUsuarios = strUsuarios & "," & CStr(MiGrupo.PluginInterface.Users(lngUsuario))
                End If
            Next lngUsuario
            Set MisUsuarios = IStore.Query("SELECT SI_NAME " & _
                "FROM CI_SYSTEMOBJECTS " & _
                "WHERE SI_KIND='User' " & _
                "AND SI_ID IN (" & strUsuarios & ") " & _
                "ORDER BY SI_NAME")
            strUsuarios = ""
            For lngUsuario = 1 To MisUsuarios.Count
                If lngUsuario > 1 Then
                    RowNum = RowNum + 1
                    Rng(RowNum, 1) = MiGrupo.ID
                    Rng(RowNum, 2) = MiGrupo.Title
                    Rng(RowNum, 3) = MiGrupo.Description
                    Rng(RowNum, 5) = "INFORMATIQUE"
                    Rng(RowNum, 6) = "DSI"
                    'recherche Infocentre et Carmi concernée
                    Call initinfo(MiGrupo, Rng, RowNum)
 
                    strUsuarios = ""
                End If
                If Len(strUsuarios) > 0 Then
                    strUsuarios = strUsuarios & vbLf
                End If
                strUsuarios = strUsuarios & MisUsuarios(lngUsuario).Title
                Rng(RowNum, 4) = LCase(strUsuarios)
                If (strUsuarios Like "*gdr *" Or strUsuarios Like "*test*" Or strUsuarios Like "*TEST*") Then
                   Rng(RowNum, 5) = "INFORMATIQUE"
                   Rng(RowNum, 6) = "DSI"
                End If
 
            Next lngUsuario
        Else
           RowNum = RowNum - 1
        End If
        'Rng(RowNum, 4) = strUsuarios
    Next MiGrupo
 
    Application.Calculation = ModeRecalcul
    Calculate
    Application.EnableEvents = True
 
CleanUp:
 
    On Error Resume Next
    esession.Logoff
    Application.Calculation = ModeRecalcul
    Calculate
    Application.EnableEvents = True
 
    Call MsgBox("Data OK", vbInformation, "MAJ Groupes")
    Exit Sub
 
ErrorHandler:
    If Err.Number = -2147210697 Then
        If ErrorState = "FullName" Then Rng(RowNum, 3) = "Error on Full Name"
        If ErrorState = "LastLogon" Then Rng(RowNum, 9) = ""
        Resume Next
    End If
 
    MsgBox Err.Source & " - " & Err.Number & ":  " & Err.Description & " " & Err.HelpContext, _
        vbCritical, "Failure in UsersGroups()"
    Resume CleanUp
 
 
End Sub
Sub initinfo(MiGrupo, Rng, RowNum)
'recherche Infocentre et Carmi concernée
        If Not (MiGrupo.Title Like "*BO_AVAN*" Or MiGrupo.Title Like "*DEV*" Or MiGrupo.Title Like "*TEST*" Or MiGrupo.Title Like "*TSTU*") Then
           If MiGrupo.Title Like "*CASS*" Then
               Rng(RowNum, 5) = "CASSIOPEE"
           Else
            If MiGrupo.Title Like "*AGST*" Or MiGrupo.Title Like "AS *" Then
               Rng(RowNum, 5) = "AGENSTAT"
            Else
             If MiGrupo.Title Like "*CASC*" Then
               Rng(RowNum, 5) = "CASCADES"
             Else
              If MiGrupo.Title Like "*GDR*" Then
                Rng(RowNum, 5) = "GDR"
              Else
               If MiGrupo.Title Like "*PAREOS*" Then
                 Rng(RowNum, 5) = "PAREOS"
                 Rng(RowNum, 6) = "CARMI DU SUD EST"
               Else
                If MiGrupo.Title Like "*PRIAM*" Then
                  Rng(RowNum, 5) = "PRIAM"
                Else
                 If MiGrupo.Title Like "*PLE*" Then
                  Rng(RowNum, 5) = "PLEIADES"
                 Else
                    If MiGrupo.Title Like "*COG*" Then
                        Rng(RowNum, 5) = "COG-CPG"
                    Else
                        If MiGrupo.Title Like "*GPEC*" Then
                            Rng(RowNum, 5) = "GPEC"
                        Else
                                If MiGrupo.Title Like "*MUT*" Then
                                    Rng(RowNum, 5) = "MUTUALISATION"
                                Else
                                        If MiGrupo.Title Like "*SCR*" Then
                                            Rng(RowNum, 5) = "SCRIBE"
                                        Else
                                                If MiGrupo.Title Like "*SIR*" Then
                                                    Rng(RowNum, 5) = "INFORMATIQUE"
                                                Else
                                                    If MiGrupo.Title Like "*TBG*" Then
                                                    Rng(RowNum, 5) = "TABLEAUX DE BORD"
                                                    Else
                                                        If MiGrupo.Title Like "*UDAS*" Then
                                                        Rng(RowNum, 5) = "UDAS"
                                                        Else
 
 
                                                    If MiGrupo.Title Like "Controle Interne CANSSM" Then
                                                    Rng(RowNum, 5) = "Contrôle Interne"
                                                    Else
                                                    If MiGrupo.Title Like "Controle Interne CENTRE OUEST" Then
                                                    Rng(RowNum, 5) = "Contrôle Interne"
                                                    Else
                                                    If MiGrupo.Title Like "Controle Interne EST" Then
                                                    Rng(RowNum, 5) = "Contrôle Interne"
                                                    Else
 
                                                    If MiGrupo.Title Like "Controle Interne NPDC" Then
                                                    Rng(RowNum, 5) = "Contrôle Interne"
                                                    Else
 
                                                    If MiGrupo.Title Like "Controle Interne SUD EST" Then
                                                    Rng(RowNum, 5) = "Contrôle Interne"
                                                    Else
 
                                                    If MiGrupo.Title Like "Controle Interne SUD OUEST" Then
                                                    Rng(RowNum, 5) = "Contrôle Interne"
 
                                                    End If
 
 
                                                    End If
 
 
                                                    End If
                                                    End If
                                                    End If
                                                    End If
                                                        End If
                                                    End If
                                                End If
                                        End If
                                End If
                        End If
                    End If
                 End If
               End If
             End If
            End If
           End If
          End If
        End If
               If MiGrupo.Title Like "*NORD*" Or MiGrupo.Title Like "*NPDC*" Or MiGrupo.Title Like "*NPC*" Then
                   Rng(RowNum, 6) = "CARMI DU NORD-PAS DE CALAIS"
               Else
                  If MiGrupo.Title Like "*CENTRE EST*" Or MiGrupo.Title Like "*CE*" Then
                    Rng(RowNum, 6) = "CARMI DU CENTRE EST"
                  Else
                   If MiGrupo.Title Like "*CENTRE*" Then
                      Rng(RowNum, 6) = "CARMI DU CENTRE"
                   Else
                    If MiGrupo.Title Like "*SUD EST*" Or MiGrupo.Title Like "*SE*" Then
                      Rng(RowNum, 6) = "CARMI DU SUD EST"
                    Else
                      If MiGrupo.Title Like "*SUD OUEST*" Or MiGrupo.Title Like "*SO*" Then
                       Rng(RowNum, 6) = "CARMI DU SUD OUEST"
                      Else
                       If MiGrupo.Title Like "*OUEST*" Then
                        Rng(RowNum, 6) = "CARMI DE l'OUEST"
                       Else
                        If MiGrupo.Title Like "* EST*" Or MiGrupo.Title Like "AGST CARMI" Then
                          Rng(RowNum, 6) = "CARMI DE L'EST"
                        Else
                         If MiGrupo.Title Like "*CANSSM*" Then
                          Rng(RowNum, 6) = "CANSSM"
                          Else
                            If MiGrupo.Title Like "*GPEC*" Then
                                Rng(RowNum, 6) = MiGrupo.Title
                                Else
                                    If MiGrupo.Title Like "*SIR*" Then
                                        Rng(RowNum, 6) = "DSI"
                                        Else
 
 
                                         If MiGrupo.Title Like "*ANGDM*" Then
                                        Rng(RowNum, 6) = "ANGDM"
                                    Else
                                        If MiGrupo.Title Like "*GDR*" Or MiGrupo.Title Like "*PAREOS*" Or MiGrupo.Title Like "*PRIAM*" Or MiGrupo.Title Like "*MUT_*" Then
                                            Rng(RowNum, 6) = MiGrupo.Title
 
                                        Else
                                            Rng(RowNum, 6) = MiGrupo.Title & " (organisme à ajouter)"
                                        End If
                                    End If
                                End If
                                End If
                          End If
                        End If
                      End If
                    End If
                   End If
                  End If
               End If
           End If
        End If
 
 
 
 
                                                    If MiGrupo.Title Like "*CRE*" Or MiGrupo.Title Like "*AVAN*" Or MiGrupo.Title Like "*MODIF*" Or MiGrupo.Title Like "*BO_UTIL_G15*" Or MiGrupo.Title Like "*PLEIADES*" Or MiGrupo.Title Like "*SCRIBE*" Or MiGrupo.Title Like "*UDAS*" Then
                                                    Rng(RowNum, 7) = "Créateur"
                                                    Else
                                                 Rng(RowNum, 7) = "Visualisateur"
                                                 End If
'FIN recherche Infocentre et Carmi concernée
    Exit Sub
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
End Sub

"

[EngueEngue]

Trouve nous où plante ton code avec l'execution pas à pas, en appuyant sur F8...
à mon avis tu as un problème avec ça... et je ne connais pas cet objet

Code :

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

1
2
3
4
5
6
7
8
9
10
'Session Manager instanciation
Set SessionManager = CreateObject("CrystalEnterprise.SessionMgr")
'Enterprise Session instanciation
Set esession = SessionManager.Logon(DameUserName(), DamePassword(), DameCMS(), "secEnterprise")
'Infostore instanciation
Set IStore = esession.Service("", "InfoStore")
'document the reports
Set MisGrupos = IStore.Query( _
"SELECT TOP 1000000 SI_ID, SI_NAME, SI_DESCRIPTION, SI_GROUP_MEMBERS FROM CI_SYSTEMOBJECTS " & _
"Where SI_KIND='UserGroup' ORDER BY SI_NAME")