Problème VBA générant du code VBA "l'indice n'appartient pas à la selection"

**Access Newbie** · 22/04/2011, 10h19

Bonjour à tous,

J'ai un pitit problème avec un bout de code que je viens de créer, celui-ci permet de générer du code (le code d'un evenement chart_activate). Mon problème est le suivant :

sur la ligne

Code :

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

  With ActiveWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(strSheetName).CodeName).CodeModule

j'ai souvent (mais pas tout le temps) l'erreur "l'indice n'appartient pas à la selection". Le souci viens du fait que "ThisWorkbook.Sheets(strSheetName).CodeName" n'a pas toujours une valeur: si je met une variable dans laquelle je récupère le codeName, parfois celui-ci est égal à "" ... bizarre.

C'est d'autant plus étrange que lorsque j'ai l'erreur, je ne fais absolument rien, c'est à dire que je ne fais qu'appuyer sur F5 pour que le code se termine, et là tout se déroule correctement.

Avez-vous déjà eu un problème similaire ? avez-vous une solution pour contourner le problème ?

Merci d'avance,

Ci-dessous le code de la procédure incriminée.

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
Sub AddEventToChart(strSheetName As String)
'ajoute l evenement chart calculate

Application.DisplayAlerts = False
Application.EnableEvents = False

ThisWorkbook.Sheets(strSheetName).Activate
ThisWorkbook.Sheets(strSheetName).Select

  With ActiveWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(strSheetName).CodeName).CodeModule    'Creation de la procedure evenementielle
    .CreateEventProc "Calculate", "Chart"
    
    'code de la procédure
    .InsertLines 2, "Dim newChart as Chart"
    .InsertLines 3, "set newChart = ActiveChart"
    .InsertLines 4, "newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name"
  End With

Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

**mercatog** · 22/04/2011, 10h48

Bonjour
Tu travailles avec un seul classeur ou plusieurs?
Tu mélange le ActiveWorkbook et le ThisWorkbook qui peuvent différer si tu as plusieurs classeurs ouverts.

**Philippe Tulliez** · 22/04/2011, 11h02

Bonjour,
Comme l'a justement écrit Mercatog, tu mélanges les objets.
C'est soit

Code :

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

 With ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Sheets(strSheetName).CodeName).CodeModule    'Creation de la procedure evenementielle

Soit

Code :

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

With ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(strSheetName).CodeName).CodeModule    'Creation de la procedure evenementielle

De plus, il n'y a aucune raison de sélectionner la feuille

Code :

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

'ThisWorkbook.Sheets(strSheetName).Activate

**Access Newbie** · 22/04/2011, 11h43

Tout d'abord merci pour vos réponses

Je viens de faire le test en mettant des "thisworkbook" partout : j'ai toujours la même erreur.

De même en utilisant "ActiveWorkbook".

PS : je ne travaille que sur un seul fichier Excel.

**mercatog** · 22/04/2011, 12h00

J'ai fais ce test sans problème. Le code s'écrit bien dans le module de Graph 1

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
Sub AddEventToChart(strSheetName As String)
 
With ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(strSheetName).CodeName).CodeModule    'Creation de la procedure evenementielle
    .InsertLines 2, "Private Sub Chart_Calculate()"
    .InsertLines 3, "Dim newChart as Chart"
    .InsertLines 4, "set newChart = ActiveChart"
    .InsertLines 5, "newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name"
    .InsertLines 6, "End Sub"
End With
End Sub
 
Sub test()
 
AddEventToChart "Graph1"
End Sub

Dans le module de Graph 1 je trouve bien ceci

Code :

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

1
2
3
4
5
Private Sub Chart_Calculate()
Dim newChart As Chart
Set newChart = ActiveChart
newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name
End Sub

**Access Newbie** · 22/04/2011, 14h41

Si j'utilise ce code sur une feuille existante, en effet, il n'y a pas de problème.

En fait je crée des feuilles (dans une boucle) et ensuite j'éxécute cette procédure. j'ai l'impression qu'en fait la feuille n'est "pas totalement créée, ou en cours de création" et du coup le vba ne peut récupérer le codeName.

En tout cas merci pour votre aide

**mercatog** · 22/04/2011, 14h49

Remet ton code de création des graphiques, le problème et la

J'ai fais un petit test (création de graphiques et affectation du code)
à tester

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
Sub AddEventToChart(ByVal strSheetName As String)
 
With ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(strSheetName).CodeName).CodeModule    'Creation de la procedure evenementielle
    .InsertLines 2, "Private Sub Chart_Calculate()"
    .InsertLines 3, "Dim newChart as Chart"
    .InsertLines 4, "set newChart = ActiveChart"
    .InsertLines 5, "newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name"
    .InsertLines 6, "End Sub"
End With
End Sub
 
Sub test()
Dim Ch As Chart
Dim i As Byte
For i = 1 To 4
    Set Ch = ThisWorkbook.Charts.Add
    Call AddEventToChart(Ch.Name)
    Set Ch = Nothing
Next i
End Sub

PS: à quoi sert le code Calculate de tes graphiques.

**Philippe Tulliez** · 22/04/2011, 14h59

Bonjour,
Je confirme que moi également j'ai fait tourner le code sans aucun problème.

**patricktoulon** · 22/04/2011, 15h01

bonjour

comment appelle tu ta macro

si tu l'appelle comme ceci

Code :

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

call AddEventToChart

ca ne peut pas marcher
appelle la comme ca

Code :

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

AddEventToChart "nom de la feuille"

au plaisir

**Access Newbie** · 22/04/2011, 15h02

La partie qui nous interesse est dans la procédure "ManageFields" je pense, mais je met tout au cas où.

Le traitement est lancé par la proc "GenerateTCD".

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
Sub GenerateTCD()
'genere l'ensemble des tableaux croisés du fichier Excel
 
Dim rst As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim strDir As String
 
'temporaire
Bouton56_QuandClic
 
'connection sur le fichier excel actif
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
 
'selectionne l'ensemble des tableaux a creer
'[DataWorkSheet] est une plage nommée
rst.Open "select * from [DataWorkSheet] where Worksheet is not null", cnn
 
Do While Not rst.EOF
    Call CreateTCD(rst.Fields("Worksheet"), rst.Fields("SQL"), NZ(rst.Fields("Visible"), "Y"))
    rst.MoveNext
Loop
 
ThisWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
 
Call GenerateAppButtons
 
rst.Close
Set rst = Nothing
 
Call CloseVBE
 
'Application.DisplayAlerts = False
'ThisWorkbook.Sheets("Param").Delete
'Application.DisplayAlerts = True
'
'ThisWorkbook.Save
 
End Sub

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
Sub CreateTCD(strSheetName As String, strSQL As String, strVisible As String)
'crée un tableau croisé dynamique
 
Dim strDir As String
Dim newSht As Worksheet
Dim boVisible As Boolean
 
'recupere le repertoire ou se situe l'appli
strDir = ThisWorkbook.Path
 
'le TCD doit-il etre affiché
boVisible = IIf(strVisible = "Y", True, False)
 
'création l une nouvelle feuille dans le classeur
Set newSht = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(Sheets.Count))
newSht.Name = strSheetName
 
With ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
    .CommandText = strSQL
    .MissingItemsLimit = xlMissingItemsNone
    .Connection = "ODBC;DBQ=" & strDir & ";DefaultDir=" & strDir _
                & ";Driver={Microsoft Text Driver (*.txt; *.csv)};" _
                & "DriverId=27;FIL=text;MaxBufferSize=2048;MaxScanRows=8;" _
                & "PageTimeout=5;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;"
    .CreatePivotTable TableDestination:=Sheets(strSheetName).Range("A1"), _
        TableName:=strSheetName & "_TCD"
    .Refresh
    Call ManageFields(strSheetName)
    Worksheets(strSheetName).Visible = boVisible
End With
 
Set newSht = Nothing
Set newChart = Nothing
 
End Sub

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
Sub ManageFields(strSheetName As String)
'permet de gérer chaque champ de maniere indépendante
 
Dim rst As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim intOrientation As Integer
Dim intFunction As Integer
Dim strField As String
Dim strCol As String
Dim pvtField As PivotField
Dim newChart As Chart
Dim boIsChart As Boolean
 
'connection sur le fichier excel actif
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
 
'gestion des graphs
'[GfxSheet] est une plage nommée
rst.Open "select * from [GfxSheet] Where [Based on data worksheet]='" & strSheetName & "'", cnn
 
If rst.EOF Then
    Set newChart = Nothing
    boIsChart = False
Else
    'creation du graphique croisé dynamique
    Set newChart = Charts.Add
    newChart.Location Where:=xlLocationAsNewSheet
    newChart.Name = strSheetName & "_Graph"
    newChart.ChartType = GetChartType(rst.Fields("Graph Type"))
    boIsChart = True
 
    'mise en forme du graph
    Call FormatGraph(newChart)
End If
rst.Close
 
'parcours l'ensemble des champ a afficher en champ de page / ligne / colonne / donnée
'[ColumnGfx] est une plage nommée
rst.Open "select * from [ColumnGfx] Where WorkSheet='" & strSheetName & "' ORDER BY 6 DESC, 3 ASC", cnn, adOpenStatic, adLockOptimistic
 
Do While Not rst.EOF
    strField = rst.Fields("Column")
    intOrientation = GetOrientation(rst.Fields("Orientation"))
    intFunction = GetFunction(NZ(rst.Fields("Calculation type"), ""))
 
    'si c est un champ de donnée
    If intOrientation = xlDataField Then
        Set pvtField = Worksheets(strSheetName).PivotTables(1).PivotFields(strField)
        With Worksheets(strSheetName).PivotTables(1)
            .AddDataField pvtField, NZ(rst.Fields("Calculation type"), "") & " " & strField, intFunction
        End With
    Else
    'si c est un champ de page / colonne / ligne
        With Worksheets(strSheetName).PivotTables(1).PivotFields(strField)
            .Orientation = intOrientation
            .Position = rst.Fields("Position")
 
            'si c'est un champ de colonne
            If intOrientation = xlColumnField And boIsChart Then
                strCol = NZ(rst.Fields("Column Value"), "")
                Do While strCol <> "" And strCol = NZ(rst.Fields("Column Value"), "") And Not rst.EOF
                    newChart.SeriesCollection(strCol).ChartType = GetChartType(rst.Fields("Graph Type"))
                    rst.MoveNext
                    If rst.EOF Then Exit Do
                    strCol = NZ(rst.Fields("Column Value"), "")
                Loop
                rst.MoveLast
            End If
        End With
    End If
 
    'affiche une valeur par défaut
    If Not IsNull(rst.Fields("Selected")) Then _
        Worksheets(strSheetName).PivotTables(1).PivotFields(strField).CurrentPage = "P1"
 
    rst.MoveNext
Loop
 
'enregistre les formats des différentes series
If boIsChart Then
    Application.AddChartAutoFormat Chart:=newChart, Name:=newChart.Name, Description:=""
    newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name
    Call AddEventToChart(newChart.Name)
End If
 
rst.Close
Set rst = Nothing
Set newChart = Nothing
 
End Sub

**mercatog** · 22/04/2011, 15h51

Bon, pour faire simple, j'ai pris la structure de ton code pour tester les points important.
j'ai testé ce code sans problème

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
Sub test()
Dim i As Byte
 
For i = 1 To 4
    Call ManageFields("Toto" & i)
Next i
End Sub
 
Sub ManageFields(strSheetName As String)
Dim newChart As Chart
Dim boIsChart As Boolean
 
 
Set newChart = ThisWorkbook.Charts.Add
newChart.Name = strSheetName & "_Graph"
newChart.ChartType = xlArea
boIsChart = True
 
 
If boIsChart Then
    Application.AddChartAutoFormat Chart:=newChart, Name:=newChart.Name, Description:=""
    newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name
    Call AddEventToChart(newChart.Name)
End If
End Sub
 
Sub AddEventToChart(ByVal strSheetName As String)
 
With ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(strSheetName).CodeName).CodeModule    'Creation de la procedure evenementielle
    .InsertLines 2, "Private Sub Chart_Calculate()"
    .InsertLines 3, "Dim newChart as Chart"
    .InsertLines 4, "set newChart = ActiveChart"
    .InsertLines 5, "newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name"
    .InsertLines 6, "End Sub"
End With
End Sub

**Access Newbie** · 22/04/2011, 17h03

Hum ... je vois pas ce qui ne va pas chez moi ...

Je vous met le fichier incriminé en PJ pour que vous voyez par vous même ce bug que je qualifierai de "paranormal" ... (bien qu'il y ait certainement une explication)

**Access Newbie** · 04/05/2011, 11h31

Je me permet de relancer ce sujet car je n'arrive vraiment pas à comprendre le souci.

C'est étrange ce problème puisqu'en fait il n'y a pas d'"erreur", puisque lorsque la fonction plante, il suffit d'appuyer sur F5 pour qu'elle se termine correctement.

J'ai essayé de mettre des doevents, j'ai également essayer d'utiliser l'API sleep pour faire attendre le programme une seconde mais rien n'y fait.

Si vous avez des idées, je suis preneur

Merci d'avance.

**neupont** · 04/05/2011, 16h07

Envoyé par Access Newbie

J'ai essayé de mettre des doevents

Pas une mauvaise idée, d'ailleurs chez moi ça marche quand je le fais

:

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
Sub AddEventToChart(strSheetName As String)
'ajoute l evenement chart calculate

Application.DisplayAlerts = False
Application.EnableEvents = False

DoEvents

With ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(strSheetName).CodeName).CodeModule
    'Creation de la procedure evenementielle
    .InsertLines 2, "Private Sub Chart_Calculate()"
    .InsertLines 3, "Dim newChart as Chart"
    .InsertLines 4, "set newChart = ActiveChart"
    .InsertLines 5, "newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name"
    .InsertLines 6, "End Sub"
End With

Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

Tu le mets bien à cet endroit-là ?
Si ça ne marche pas essaie de mettre deux DoEvents à la suite, j'ai déjà croisé des codes où c'est ce que faisaient les développeurs (à tort ou à raison, je ne sais pas).

**Access Newbie** · 05/05/2011, 09h53

Whaaaaaaaaaaa c'est trop frustrant ! ca marche chez les autres et pas chez moi

J'ai essayé d'en mettre plusieurs, rien n'y fait.

Ce problème me desespere ...

**neupont** · 06/05/2011, 11h24

Et un truc comme ça jouant sur la gestion de l'erreur jusqu'à ce qu'elle ne se produise plus (à adapter peut-être) :

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
Sub AddEventToChart(strSheetName As String)
'ajoute l evenement chart calculate

Application.DisplayAlerts = False
Application.EnableEvents = False

On Error GoTo Label_Retour
Label_Retour:
With ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets(strSheetName).CodeName).CodeModule
    'Creation de la procedure evenementielle
    .InsertLines 2, "Private Sub Chart_Calculate()"
    .InsertLines 3, "Dim newChart as Chart"
    .InsertLines 4, "set newChart = ActiveChart"
    .InsertLines 5, "newChart.ApplyCustomType ChartType:=xlUserDefined, TypeName:=newChart.Name"
    .InsertLines 6, "End Sub"
End With

On Error GoTo 0
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

**Access Newbie** · 09/05/2011, 10h20

huhu, très bonne idée

Je ne peux pas tester cela aujourd'hui, mais je te tiens au courant

**Access Newbie** · 21/06/2011, 09h46

Bonjour et désolé pour avoir mis autant de temps à répondre,

Merci neupont mais ca ne fonctionna pas non plus, j'avais toujours le même message d'erreur.

J'ai réussi à contourner le problème de la façon suivante :

j'ai ma boucle qui me génére mon TCD et le graph correspondant, je ne lance pas immediatement la procédure "AddEventToChart" (mais je crée bien mes graphiques.

Puis dans un second temps je parcours tous les charts de l'application et je lance ma procédure "AddEventToChart" sur chacun d'eux, et là miracle !!!

Merci à tous ceux qui m'ont aidé à la résolution de ce problème

Problème VBA générant du code VBA "l'indice n'appartient pas à la selection" [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager