Erreur d'exécution '9': L'indice n'appartient pas à la sélection

**Tho69** · 01/08/2013, 15h35

Bonjour,

Voici une macro qui appelle une fonction (les deux ci-dessous). Cette macro fonctionne pour la feuille 3:

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
Private Sub Workbook_Open()
 
Application.DisplayAlerts = False
 
    Const FileSource As String = "Sport"
 
    Dim wkbSrce As Workbook
    Dim last As Long
    Dim FoldersSource As Variant
    Dim subfolder As String
    'Dim x As Integer
    'Dim y As Integer
 
    'y = ThisWorkbook.Worksheets.Count
 
    'For x = 2 To y
 
        'subfolder = ThisWorkbook.Worksheets(x).Name
        subfolder = ThisWorkbook.Worksheets(3).Name
 
        If subfolder Like "STR####" Then
            FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
        End If
        If subfolder Like "SCR####" Then
            FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
        End If
 
        If Not IsEmpty(FoldersSource) Then
            Dim di As Integer
            For di = 0 To UBound(FoldersSource)
                If (ChercheEtOuvreFichierDepuis2(CStr(FoldersSource(di)) & subfolder & "\" & FileSource & ".xlsx", subfolder)) Then
                    Exit For
                End If
            Next di
        End If
 
    'Next x
 
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
 
Private Function ChercheEtOuvreFichierDepuis2(fichier As String, subfolder As String) As Boolean
 
    Dim wkbSrce As Workbook
    Dim last As Integer
    Dim FoundFile As String
    Dim x As Integer
 
    ChercheEtOuvreFichierDepuis = False
 
    FoundFile = Dir(fichier)
 
    Do While FoundFile <> ""
 
        If FoundFile <> "" Then
 
            Application.ScreenUpdating = False
 
            Set wkbSrce = Application.Workbooks.Open(fichier)
 
            'wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Worksheets(x)
            wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Worksheets(3)
 
            'ThisWorkbook.Worksheets(x).Delete
            ThisWorkbook.Worksheets(3).Delete
 
            'ThisWorkbook.Worksheets(x).Name = subfolder
            ThisWorkbook.Worksheets(3).Name = subfolder
 
            wkbSrce.Close
 
            Set wkbSrce = Nothing
 
            Application.ScreenUpdating = True
            ChercheEtOuvreFichierDepuis = True
 
            Exit Do
 
        End If
 
        FoundFile = Dir
 
    Loop
 
End Function

Mais voila, je voudrais que ce qui se passe pour la feuille 3 se passe pour toutes mes feuilles sauf la 1. Jai donc rajouter à ce code des lignes (celles que vous voyez à présent en commentaires) et supprimer les lignes 19, 61, 64 et 67.
Et j'ai une "Erreur d'exécution '9': L'indice n'appartient pas à la sélection" qui apparait sans surligner aucun caractère du code.
Si ça peut aider le fichier appelé par le nom de la première feuille s'ouvre et ne se referme pas, je pense donc que le code bug entre les lignes 58 et 69 dans le première boucle.

Si vous avez une idée de pourquoi cette erreur dans ce code, je suis tout ouïe.

Merci.

Thomas

**Daniel.C** · 01/08/2013, 16h40

Bonjour,

supprimer les lignes 19, 61, 64 et 67.

La dernière ligne du code le plus long est la lgne 45 ??? Exécute le code ligne à ligne (avec la touche F8), tu sauras où ça twiste.

**Tho69** · 01/08/2013, 17h04

Bonjour,

Merci Daniel.

Effectivement j'ai en fait supprimer la ligne 19 de Sub et les lignes 22, 25 et 28 de Function.

En utilisant F8 ça twiste(c'est un vrai terme?

) à la ligne 21 de la fonction. Mais cela ne m'éclaire pas plus

(Enfin je pense que la Function n'a pas était présenter à "x" et par conséquent elle ne veut pas danser avec lui. Mais je ne sais comment faire des présentations convenables).

Thomas

**Daniel.C** · 01/08/2013, 17h18

ça twiste(c'est un vrai terme? ) à la ligne 21

Je ne sais pas. On l'emploie dans mon entourage comme synonyme de "foirer".

On dirait que ton classeur n'a pas 3 feuilles ?

**Tho69** · 01/08/2013, 17h25

On dirait que ton classeur n'a pas 3 feuilles ?

Si le classeur contenant ces codes a 3 feuilles au moment où je test le code (en ce moment même), mais pourquoi?
HA je crois avoir compris pourquoi cette remarque: non, non le code posté fonctionne. C'est quand je fais les modifs dont j'ai parlé (commentaires qui ne le sont plus et lignes supprimées qu'il ne marche plus. Donc CE code ne marche pas et bug à la ligne 60:

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
Private Sub Workbook_Open()
 
Application.DisplayAlerts = False
 
    Const FileSource As String = "Sport"
 
    Dim wkbSrce As Workbook
    Dim last As Long
    Dim FoldersSource As Variant
    Dim subfolder As String
    Dim x As Integer
    Dim y As Integer
 
    y = ThisWorkbook.Worksheets.Count
 
    For x = 2 To y
 
        subfolder = ThisWorkbook.Worksheets(x).Name
        'subfolder = ThisWorkbook.Worksheets(3).Name
 
        If subfolder Like "STR####" Then
            FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
        End If
        If subfolder Like "SCR####" Then
            FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
        End If
 
        If Not IsEmpty(FoldersSource) Then
            Dim di As Integer
            For di = 0 To UBound(FoldersSource)
                If (ChercheEtOuvreFichierDepuis2(CStr(FoldersSource(di)) & subfolder & "\" & FileSource & ".xlsx", subfolder)) Then
                    Exit For
                End If
            Next di
        End If
 
    Next x
 
End Sub
 
Private Function ChercheEtOuvreFichierDepuis2(Fichier As String, subfolder As String) As Boolean
 
    Dim wkbSrce As Workbook
    Dim last As Integer
    Dim FoundFile As String
    Dim x As Integer
 
    ChercheEtOuvreFichierDepuis2 = False
 
    FoundFile = Dir(Fichier)
 
    Do While FoundFile <> ""
 
        If FoundFile <> "" Then
 
            Application.ScreenUpdating = False
 
            Set wkbSrce = Application.Workbooks.Open(Fichier)
 
            wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Worksheets(x)
            'wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Worksheets(3)
 
            ThisWorkbook.Worksheets(x).Delete
            'ThisWorkbook.Worksheets(3).Delete
 
            ThisWorkbook.Worksheets(x).Name = subfolder
            'ThisWorkbook.Worksheets(3).Name = subfolder
 
            wkbSrce.Close
 
            Set wkbSrce = Nothing
 
            Application.ScreenUpdating = True
 
            ChercheEtOuvreFichierDepuis2 = True
 
            Exit Do
 
        End If
 
        FoundFile = Dir
 
    Loop
 
End Function

**Daniel.C** · 01/08/2013, 17h52

"x" n'est pas initialisé.

**Tho69** · 01/08/2013, 18h01

Merci.
Je ne suis instruis sur comment et pourquoi initialisé (je vais m'instruire dès maintenant). Mais il bug dans la première boucle et dans la première boucle il n'est pas censé être égal à 2? Pouvez-vous me donner plus de détails?

**Daniel.C** · 01/08/2013, 18h34

Quand tu exécutes le code de ta fonction, tu ne mets pas de valeur à la variable "x"; comme tu l'as définis comme "Integer", sa valeur est égale à 0. Quand tu arrives sur la ligne :

Code :

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

wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Worksheets(x)

tu cherches la feuille d'indice 0 ce qui provoque une erreur, la valeur de la première feuille étant 1. C'est ce que le message te dit " L'indice n'appartient pas à la sélection" l'indice c'est x et la sélection c'est "Worksheets". Histoire de te dire que "WorkSheets(0)", ça n'existe pas.

**Tho69** · 02/08/2013, 09h12

Bonjour,

Merci Daniel.
Je me suis aperçu d'autre chose, étant donné que dans la Sub je dis subfolder = ThisWorkbook.Worksheets(x).Name, je n'ai pas besoin d'utiliser x dans la Function. Donc le code qui fonctionne est:

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
Private Sub Workbook_Open()
 
Application.DisplayAlerts = False
 
    Const FileSource As String = "Sport"
 
    Dim wkbSrce As Workbook
    Dim last As Long
    Dim FoldersSource As Variant
    Dim subfolder As String
    Dim x As Integer
    Dim y As Integer
 
    y = ThisWorkbook.Worksheets.Count
 
    For x = 2 To y
 
        subfolder = ThisWorkbook.Worksheets(x).Name
 
        If subfolder Like "STR####" Then
            FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
        End If
        If subfolder Like "SCR####" Then
            FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
        End If
 
        If Not IsEmpty(FoldersSource) Then
            Dim di As Integer
            For di = 0 To UBound(FoldersSource)
                If (ChercheEtOuvreFichierDepuis2(CStr(FoldersSource(di)) & subfolder & "\" & FileSource & ".xlsx", subfolder)) Then
                    Exit For
                End If
            Next di
        End If
 
    Next x
 
End Sub
 
Private Function ChercheEtOuvreFichierDepuis2(Fichier As String, subfolder As String) As Boolean
 
    Dim wkbSrce As Workbook
    Dim last As Integer
    Dim FoundFile As String
    Dim subfolder As String
 
    ChercheEtOuvreFichierDepuis2 = False
 
    FoundFile = Dir(Fichier)
 
    Do While FoundFile <> ""
 
        If FoundFile <> "" Then
 
            Application.ScreenUpdating = False
 
            Set wkbSrce = Application.Workbooks.Open(Fichier)
 
            wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Worksheets(subfolder)
 
            ThisWorkbook.Worksheets(subfolder).Delete
 
            ThisWorkbook.Worksheets("Feuil1").Name = subfolder
 
            wkbSrce.Close
 
            Set wkbSrce = Nothing
 
            Application.ScreenUpdating = True
 
            ChercheEtOuvreFichierDepuis2 = True
 
            Exit Do
 
        End If
 
        FoundFile = Dir
 
    Loop
 
End Function

Erreur d'exécution '9': L'indice n'appartient pas à la sélection

Macros et VBA Excel

Discussions similaires

Partager

Partager