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

Version imprimable

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:

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:

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

22/04/2011, 10h48
mercatog

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.
22/04/2011, 11h02
Philippe Tulliez

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

Code:

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

Soit

Code:

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:

'ThisWorkbook.Sheets(strSheetName).Activate
22/04/2011, 11h43
Access Newbie

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.

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

Code:

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:

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

22/04/2011, 14h41
Access Newbie

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 ;)

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:

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.

22/04/2011, 14h59
Philippe Tulliez

Bonjour,
Je confirme que moi également j'ai fait tourner le code sans aucun problème.
22/04/2011, 15h01
patricktoulon

heu!...

bonjour

comment appelle tu ta macro

si tu l'appelle comme ceci

Code:

call AddEventToChart

ca ne peut pas marcher
appelle la comme ca

Code:

AddEventToChart "nom de la feuille"

au plaisir

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:

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:

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:

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

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:

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

22/04/2011, 17h03
Access Newbie

1 pièce(s) jointe(s)

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)
04/05/2011, 11h31
Access Newbie

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.

Citation:

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 :mrgreen: :
Code:

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).

05/05/2011, 09h53
Access Newbie

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

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

Ce problème me desespere ...

:arf::piou::mur::pc::traine:

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

Code:

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

09/05/2011, 10h20
Access Newbie

huhu, très bonne idée ;)

Je ne peux pas tester cela aujourd'hui, mais je te tiens au courant :ccool:
21/06/2011, 09h46
Access Newbie

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 :ccool: