Problème pour l'ouverture d'un fichier Excel suite à une macro VBA

Version imprimable

Salut à tous :salut:

Amis développeur de VBA, voici une nouvelle macro à checker.

Je souhaite créer une macro qui me saisissent automatiquement des données à partir d'une BDD dans un autre classeur Excel.
Pour ce faire, j'ai créer un code à partir d'un bouton. Voici le code en question :

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
 
'Ce code permet de saisir les données 
Private Sub btn_Saisie_Click()
    'Déclaration du fichier Excel de l'axe choisi
    Dim Wb As Workbook
    Set Wb = GetObject("C:\Documents\Fichier\Macro\Macro.xlsm")
    Wb.Windows(1).Visible = True
    'Déclaration des variables utilisées pour le code. l et c sont les variables des lignes et des colonnes
    'i le numéro de feuille du classeur, le compteur permet de gérer le cas des montées / descentes
    'd s'occupe de décaler les valeurs pour chaque date et r s'occupe du test sur le rang
    Dim l As Integer
    Dim c As Integer
    Dim j As Integer
    Dim d As Integer
    Dim compteur As Integer
    Dim i As Integer
    'Boucle for i parcourant toute les feuilles du classeur
    For i = 2 To 7
    'Boucle for c parcourant les colonnes de la feuille
        For c = 3 To 50
            d = 0
            'compteur = 0
            'Boucle for l parcourant les lignes de la feuille 
            For l = 2 To 9205
 
                'On ajoute la date dans sa ligne correspondante dans le tableau de résultats
                'Si la date de la ligne suivante n'est pas égale à la date actuelle alors
                'on incrémente de 1 la variable d et on réiniatilise la variable r à 1
                    For j = 30 To 68 Step 2
 
                        If Worksheets(1).Cells(l, 14) <> Worksheets(1).Cells(l - 1, 14) Then
                            d = d + 1
                            Wb.Worksheets(i).Cells(23, c + d) = Worksheets(1).Cells(l, 14)
                            Wb.Worksheets(i).Cells(24, c + d) = Weekday(Wb.Worksheets(i).Cells(23, c + d))
                            If Wb.Worksheets(1).Cells(j, c) = Worksheets(1).Cells(l, 6) Or Wb.Worksheets(1).Cells(j + 1, c) = Worksheets(1).Cells(l, 7) Then
                                'Wb.Worksheets(1).Cells(j, c + d) = Worksheets(1).Cells(l + compteur, 6)
                                'Wb.Worksheets(1).Cells(j + 1, c + d) = Worksheets(1).Cells(l + compteur, 7)
                            End If
                        Else
                            Wb.Worksheets(i).Cells(23, c) = Worksheets(1).Cells(l, 14)
                            Wb.Worksheets(i).Cells(24, c) = Weekday(Wb.Worksheets(i).Cells(23, c))
                        End If
 
                        If Worksheets(1).Cells(l, 9) = Wb.Worksheets(i).Cells(j, 2) Then
                            Wb.Worksheets(i).Cells(j, c) = Worksheets(1).Cells(l, 6)
                            Wb.Worksheets(i).Cells(j + 1, c) = Worksheets(1).Cells(l, 7)
                            compteur = compteur + 1
                        End If
 
                    Next j
                End If
 
            Next l
        Next c
    Next i
End Sub

Le code fonctionne. Seulement il met du temps à se lancer, normal je traite une BDD de 10 000 lignes.
Mais le problème vient du fait qu'après la fin de la macro, je ne peux plus ouvrir mes fichiers Excel.
Et pourtant la macro est finie, je n'ai même pas d'option tel que "Excel ne répond pas".
J'ai peut-être fait une erreur dans mon programme, mais actuellement je ne trouve pas.
Je vais continuer à chercher à coup de pas à pas. Mais si quelqu'un peut m'éclairer sur le sujet ça m'aiderait énormément :mrgreen: :arf:

20/11/2015, 16h18
HopPopPop

Bonjour à tous,

Je ne pense pas que c'est dû à cela, mais il est bon de libérer les variables objet. Tu devrais mettre à la fin de ta procédure

Code:

Set Wb = Nothing

Par ailleurs, tu peux accélérer ta macro en utilisant

Code:

Application.ScreenUpdating = False ' à mettre avant la boucle For i

puis

Code:

Application.ScreenUpdating = True ' à mettre après la ligne Next i
23/11/2015, 10h45
BDA53

Merci pour ta réponse,

néanmoins ça ne change rien au problème d'éxécution
23/11/2015, 12h34
bboy-eazy

Bonjour,

Peut être vaut il mieux boucler en passant par des variables tableaux.

Bonjour,

Déjà, je ferais plutôt ça :
Code:

1 2 3 If Dir("C:\Documents\Fichier\Macro\Macro.xlsm") = "" Then Exit Sub Set Wb = Workbooks.Open("C:\Documents\Fichier\Macro\Macro.xlsm")
que ça :
Code:

1 2 3 Set Wb = GetObject("C:\Documents\Fichier\Macro\Macro.xlsm") Wb.Windows(1).Visible = True
Quand on travaille sur plus d'un classeur, il est préférable de les différencier explicitement :
Code:

1 2 3 4 5 6 7 Dim CeWb As Workbook '... Set CeWb = ThisWorkbook '... '... Wb.Worksheets(i).Cells(23, c + d) = CeWb.Worksheets(1).Cells(l, 14)
Ensuite, ton code étant assez compliqué à déchiffrer (avec ces boucles imbriquées), il ne va pas être facile de t'aider sans plus d'explications !

J'ai donc fait quelques modifs, ce qui donne le code suivant :

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
 
Option Explicit
 
'Cette code permet de saisir les données de la feuille comptage dans la feuille de l'axe choisi'
Private Sub btn_Saisie_Click()
    'Déclaration du fichier Excel de l'axe choisi
    Dim Wb As Workbook
    Set Wb = GetObject("C:\Users\9404915j\Documents\FichierSNCF\MacroComptage\MacroMetzForbach.xlsm")
    Wb.Windows(1).Visible = True
 
    'Déclaration des variables utilisées pour le code. l et c sont les variables des lignes et des colonnes
    'i le numéro de feuille du classeur, le compteur permet de gérer le cas des montées / descentes
    'd s'occupe de décaler les valeurs pour chaque date et r s'occupe du test sur le rang
    Dim t(9205, 50) As Integer
    Dim l, c As Integer
    Dim j As Integer
    Dim d As Integer
    Dim compteur As Integer
    Dim i As Integer
 
 
    'Boucle for i parcourant toute les feuilles du classeur
    Application.ScreenUpdating = False  ' à mettre avant la boucle For i
 
    Dim CeWb As Workbook
    Set CeWb = ThisWorkbook
 
    For i = 2 To 7
    'Boucle for c parcourant les colonnes de la fiche horaire
 
        For c = LBound(t, 2) To UBound(t, 2)
 
            d = 0
            compteur = 0
            'Boucle for l parcourant les lignes de la feuille de comptage
            For l = LBound(t, 1) To UBound(t, 1)
 
                If CeWb.Worksheets(1).Cells(l, 1) = Wb.Worksheets(i).Cells(3, c) Then
                'On ajoute la date dans sa ligne correspondante dans le tableau de résultats
                'Si la date de la ligne suivante n'est pas égale à la date actuelle alors
                'on incrémente de 1 la variable d et on réiniatilise la variable r à 1
 
                    For j = 30 To 68 Step 2
 
                        If CeWb.Worksheets(1).Cells(l, 14) <> CeWb.Worksheets(1).Cells(l - 1, 14) Then
 
                            d = d + 1
 
                            Wb.Worksheets(i).Cells(23, c + d) = CeWb.Worksheets(1).Cells(l, 14)
                            Wb.Worksheets(i).Cells(24, c + d) = Weekday(Wb.Worksheets(i).Cells(23, c + d))
 
                            If Wb.Worksheets(1).Cells(j, c) = CeWb.Worksheets(1).Cells(l, 6) Or Wb.Worksheets(1).Cells(j + 1, c) = CeWb.Worksheets(1).Cells(l, 7) Then
                                Wb.Worksheets(1).Cells(j, c + d) = CeWb.Worksheets(1).Cells(l + compteur, 6)
                                Wb.Worksheets(1).Cells(j + 1, c + d) = CeWb.Worksheets(1).Cells(l + compteur, 7)
                            End If
 
                        Else
                            Wb.Worksheets(i).Cells(23, c) = CeWb.Worksheets(1).Cells(l, 14)
                            Wb.Worksheets(i).Cells(24, c) = Weekday(Wb.Worksheets(i).Cells(23, c))
                        End If
 
                        If CeWb.Worksheets(1).Cells(l, 9) = Wb.Worksheets(i).Cells(j, 2) Then
                            Wb.Worksheets(i).Cells(j, c) = CeWb.Worksheets(1).Cells(l, 6)
                            Wb.Worksheets(i).Cells(j + 1, c) = CeWb.Worksheets(1).Cells(l, 7)
                            compteur = compteur + 1
                        End If
 
                    Next j
 
                End If
 
            Next l
 
        Next c
 
    Next i
 
    Application.ScreenUpdating = True ' à mettre après la ligne Next i
    Set Wb = Nothing
 
End Sub

Le problème reste inchangé.

Pour répondre à Theze, mon but avec ce programme est de saisir automatiquement à partir d'un clique bouton mes données provenant d'un classeur excel et de les ajouter à une feuille existante de calcul.
Cette feuille contient une fiche horaire ayant en intitulé colonne un numéro ID, une période (été,scolaire) et intitulé ligne des villes.
Avec cette fiche, je réalise en dessous un tableau de résultats.

Mon tableau de résultats où les données doivent être saisies, a quelques particularités :
-Pour chaque ville, mon tableau a 2 lignes de résultats
-Pour chaque numéro ID, il peut y avoir plusieurs séries de résultats. Ce qui fait que la date est différente selon chaque série.
-Je souhaite afficher la date où le résultat a été effectué. Puis ajouter en dessous de la date, le jour (lundi,mardi,mercredi,etc...). La date étant une donnée de la BDD et non le jour.
-Je rajoute des lignes de "total" des résultats, qui sont calculées directement avec des formules excel.

Voilà ! Je n'ai peut-être pas été très clair dans mes explications, alors n'hésitez pas à me dire ce que vous n'avez pas compris :zoubi:

26/11/2015, 17h14
Theze
Bonjour,

Avec ceci :
Code:

1 2 Dim t(9205, 50) As Integer
tu déclares un tableau en base 0 donc, pour la première dimension de 0 à 9205 (soit 9206 lignes) et pour la seconde de 0 à 50 (soit 51 colonnes) mais avec ceci :
Code:

1 2 3 4 5 For l = LBound(t, 1) To UBound(t, 1) ... ... If CeWb.Worksheets(1).Cells(l, 14) <> CeWb.Worksheets(1).Cells(l - 1, 14) Then
forcément ça doit planter (je n'ai pas testé et ce n'en est pas la peine car il n'existe pas de ligne 0 donc pas de Cells(0, 14) (où l a pour valeur zéro à la première passe) et encore moins de ligne -1 donc pas de Cells(-1, 10) !
Pour que ton tableau commence à 1, déclare-le de cette façon :
Soit en tête de module tu inscris "Option Base 1" soit (et c'est la méthode la plus utilisée) :
Code:

1 2 Dim t(1 To 9205, 1 To 50) As Integer
comme ça, la variable boucle "l" aura à la première passe la valeur 1 mais il y aura toujours le problème de "Cells(l - 1, 14)" car 1 - 1 = 0 et comme il n'existe pas de ligne 0 ça plantera encore. Je crois qu'il te faut, avec ce que je viens de dire, que tu contrôle bien quelle ligne tu veux viser et adapter ta valeur
Tu peux même vérifier ce que je te dis avec :
Code:

1 2 3 4 5 6 Sub Test() Dim t(9205, 50) As Integer MsgBox LBound(t, 1) MsgBox LBound(t, 2) End Sub
Je ne suis pas allé plus loin car avec des comptages comme ceci c'est pas facile à déchiffrer :
Code:

1 2 Wb.Worksheets(1).Cells(j + 1, c + d) = CeWb.Worksheets(1).Cells(l + compteur, 7)
27/11/2015, 10h40
BDA53

Résumé des compteurs :

-Il se peut que j'ai plusieurs résultats avec des dates différentes. La variable d sert à décaler dans la colonne suivante le deuxième résultat avec une date différente au premier.
-La variable compteur permet de repasser les lignes de tableau depuis le début pour le deuxième résultat et non en dessous des lignes du premier résultat.
-La variable j correspond à l'indice de la ligne du tableau de résultats

Si ce n'est toujours pas clair n'hésite pas à me le dire.