[XL-2003] Problème de fonctionnement d'une Macro [Résolu]

[jphflo]

Bonjour à tous,

J'ai créé une Macro qui permet de recopier un nombre de fois, défini par l'utilisateur, un modèle de feuille Excel.
Malheureusement, avec certain ordinateur, cette fonction Bug lorsque que la demande de recopie est supérieur à 45 recopie.
Je pense que cela est peut être dû à un manque de mémoire.
Car, le model à recopier contiens quelques boutons associer à des Macros.
J'ai fait un essai avec une page vierge, comme modèle, sans bouton et tout fonctionne bien.
Je vous glisse en pièce jointe mon fichier d'essai.
Est-ce que quelqu'un peu tester ma macro " Création de Semaines" pour voir si cela Bug ?
Est-il possible de modifier cette Macro pour éviter ce problème ?
Enfin, le problème est-il dû à un manque de mémoire ou autre ?


Voici le message qui s'affiche lors du Bug.

Erreur d'exécution '1004':
La méthode Copy de la classe Worksheet a échoué.

Merci d'avance pour les réponses à mes questions.

Bonsoir.

jphflo.

[mercatog]

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
Sub Creation_Semaine()
Dim i As Integer, d As Integer, Nb As Integer
Dim Sh As Worksheet
Dim Rep As Variant
 
Application.ScreenUpdating = False
With Worksheets("Modèle")
    .Unprotect Password:="aze"
    d = Val(.Range("K2").Value)
    Rep = InputBox("Nombre de semaines à créer ", "Création Semaine")
    Nb = Int(Val(Rep))
 
    If Nb > 0 Then
        For i = 1 To Nb
            d = d + 1
            If Not Existe("S " & d) Then
                .Copy After:=Sheets(Sheets.Count)
                DoEvents
                ActiveSheet.Name = "S " & d
                Range("K2") = d
            End If
        Next i
    End If
 
    .Range("K2").Value = d
    .Protect Password:="aze"
End With
End Sub
 
Private Function Existe(ByVal Str As String) As Boolean
Dim Sh As Object
 
For Each Sh In ThisWorkbook.Sheets
    If Sh.Name = Str Then
        Existe = True
        Exit For
    End If
Next Sh
End Function

Remplace les Integer par des Byte au cas où tu ne dépassera jamais 255 feuilles.

[jphflo]

Bonjour mercatog,

Merci pour ta réponse rapide.

Je viens de tester ta Macro, malheureusement elle aussi bloc à 45 recopies.
En remplacent les Integer par des Byte, elle bloc à 38 recopies.

J'ai toujours le même message d'erreur. Le Bug se produit à la ligne 17 .Copy After:=Sheets(Sheets.Count)

Pour essayer de régler le problème je souhaite faire un enregistrement automatique du fichier toutes les 10 à 20 recopies. Mais je ne sais pas créer une nouvelle boucle et ou la placer dans la Macro.

Encore Merci pour ton aide.

jphflo

[mercatog]

Je n'arrive pas à créer ce bug chez moi même avec 200 feuilles

Sinon, pour sauvegarder après chaque 20 créations de feuilles

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
Sub Creation_Semaine()
Dim i As Integer, d As Integer, Nb As Integer
Dim Sh As Worksheet
Dim Rep As Variant
 
Application.ScreenUpdating = False
With Worksheets("Modèle")
    .Unprotect Password:="aze"
    d = Val(.Range("K2").Value)
    Rep = InputBox("Nombre de semaines à créer ", "Création Semaine")
    Nb = Int(Val(Rep))
 
    If Nb > 0 Then
        For i = 1 To Nb
            d = d + 1
            If Not Existe("S " & d) Then
                .Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = "S " & d
                Range("K2") = d
                If i Mod 20 = 0 Then ThisWorkbook.Save
                DoEvents
            End If
        Next i
    End If
 
    .Range("K2").Value = d
    .Protect Password:="aze"
End With
End Sub
 
Private Function Existe(ByVal Str As String) As Boolean
Dim Sh As Object
 
For Each Sh In ThisWorkbook.Sheets
    If Sh.Name = Str Then
        Existe = True
        Exit For
    End If
Next Sh
End Function

[gFZT82]

Bonjour,

Apparemment, cette limitation est liée à la mémoire disponible.
http://office.microsoft.com/fr-fr/ex...ksheetworkbook

Cordialement.

[jphflo]

Bonjour mercatog

Un grand merci pour le travail que tu as fait pour moi.

Au vu de ta réponse j'ai cherché à comprendre pourquoi tu ne pouvais reproduire le bug.
Voilà peut être une réponse. Mon ordinateur a 2 boots de démarrage, une session avec Windows XP 32 bites et l'autre avec Seven 64 bites, le tout avec 4 Go de mémoires.
Lorsque le fichier est ouvert avec XP et Excel 2003 le fichier Bug.
Lorsque le fichier est ouvert avec Seven et Excel 2007 pas de problème, testé avec une demande de 500 feuilles.
Conclusion, je pense que tu dois faire le teste avec une configuration sous Seven qui utilise beaucoup plus de mémoire que XP.

Malheureusement mon fichier doit pouvoir fonctionner sous XP avec Excel 2003.

Le faite d'enregistrer toute les 10 ou 15 recopie ne règle pas le problème.

Seule la fermeture et la réouverture du fichier permet de continuer à créer des feuilles.

Nouvelle idée, modifier la Macro pour enregistrer, fermer et rouvrir le fichier automatiquement afin de continuer la création de feuilles avec une nouvelle saisie manuelle dans la feuille "Initialisation".

Enregistrer et fermer le fichier ne me pose pas de problème. Seule la réouverture automatique du fichier contenant la Macro me bloque.

Voici ta Macro que j'ai modifier.

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
Sub Creation_Semaine()
Dim i As Integer, d As Integer, Nb As Integer
Dim Sh As Worksheet
Dim Rep As Variant
 
'Application.ScreenUpdating = False
With Worksheets("Modèle")
    .Unprotect Password:="aze"
    d = Val(.Range("K2").Value)
    Rep = InputBox("Nombre de semaines à créer ", "Création Semaine")
    Nb = Int(Val(Rep))
 
    If Nb > 0 Then
        For i = 1 To Nb
            d = d + 1
            If Not Existe("S " & d) Then
 
On Error GoTo Si_Erreur
 
                .Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = "S " & d
                Range("K2") = d
                'If i Mod 10 = 0 Then ThisWorkbook.save
                DoEvents
            End If
        Next i
    End If
 
    .Range("K2").Value = "=Initialisation!C17-1"
    .Protect Password:="aze"
 
End With
Exit Sub
 
Si_Erreur:
 
                MsgBox "                                                        Erreur de création !!!" & Chr(10) & "" & Chr(10) & "Votre ordinateur manque de mémoire. Le nombre de feuilles à créer en une seule fois est limité.           " & Chr(10) & "" & Chr(10) & "             Pour créer plus de feuilles, fermez le fichier et réouvrez le, pour continuer.", vbCritical, "CRU SEG Niort."
                reponse = MsgBox("Souhaitez vous que Excel se charge d'enrgistrer votre travail, ferme le fichier et le réouvrir ?", vbQuestion + vbYesNo, "CRU SEG Niort.")
 
            If reponse = 6 Then
                Sheets("initialisation").Select
                Range("C17").Select
                ThisWorkbook.Save
                ThisWorkbook.Close
            End If
 
            If reponse = 7 Then Exit Sub
 
End Sub

Si tu peux me venir de nouveau en aide cela serait super.

Merci.

Jphflo.

[jphflo]

Bonjour gFZT82,

Merci pour ta recherche qui confirme se que je pensais.

Envoyé par gFZT82

Bonjour,

Apparemment, cette limitation est liée à la mémoire disponible.
http://office.microsoft.com/fr-fr/ex...ksheetworkbook

Cordialement.

jphflo

[Ormonth]

Bonjour,

vois quand même ceci :

http://support.microsoft.com/kb/210684/fr#appliesto

Envoyé par Microsoft

Dans Microsoft Excel, vous exécutez une macro qui copie des feuilles de calcul, puis place les feuilles de calcul dans le classeur d'origine. Lors de cette opération, un message d'erreur semblable à l'un des suivants peut s'afficher :
Erreur d'exécution '1004' :
La méthode Copy de la classe Worksheet a échoué
Erreur d'exécution '1004' :
Erreur définie par l'application ou par l'objet.

Cordialement,

Ps : si le côté technique de la réponse = OK ou pas => pensez à cliquer sur les pouces et quand question résolue à la taguer résolue, et chaque action vous rapporte des points

Didier

[jphflo]

Bonsoir Ormonth,

Effectivement cela correspond bien à mon problème. Est apparemment, mon idée d'enregistrer, de fermer et rouvrir le fichier semble la bonne.

Je vois ça cette semaine et je vous tiens informer.

Cordialement

jphflo

[jphflo]

Bonsoir à tous,

Voici mon code que je vais utiliser. Il n'est pas parfait car je n'arrive pas à faire redémarrer automatiquement la création des recopies.

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
Sub Creation_Semaine()
Dim i As Integer, d As Integer, Nb As Integer
Dim Sh As Worksheet
Dim Rep As Variant
 
'Application.ScreenUpdating = False
    With Worksheets("Modèle")
        '.Unprotect Password:="aze"
        d = Val(.Range("K2").Value)
        Rep = InputBox("Nombre de semaines à créer ", "Création Semaine")
        Nb = Int(Val(Rep))
 
        If Nb > 0 Then
            For i = 1 To Nb
                d = d + 1
                If Not Existe("S " & d) Then
 
On Error GoTo Si_Erreur
 
                    .Copy After:=Sheets(Sheets.Count)
                    ActiveSheet.Name = "S " & d
                    Range("K2") = d
                    'ActiveSheet.Protect Password:="aze"
                    'If i Mod 10 = 0 Then ThisWorkbook.save
                    DoEvents
                End If
            Next i
        End If
            .Range("K2").Value = "=Initialisation!C17-1"
            '.Protect Password:="aze"
    End With
Exit Sub
 
Si_Erreur:
 
                MsgBox "                                                           Erreur de création !!!" & Chr(10) & "" & Chr(10) & "Votre ordinateur manque de mémoire. Le nombre de feuilles à créer en une seule fois est trop important.           " & Chr(10) & "" & Chr(10) & "   Pour créer plus de feuilles, fermez le fichier et relancer le, pour poursuive le processus manuellement.", vbCritical, "TITRE."
                reponse = MsgBox("Souhaitez vous que Excel se charge d'enregistrer votre travail, ferme le fichier et le relance ?", vbQuestion + vbYesNo, "TITRE.")
 
            If reponse = 6 Then
                Sheets("initialisation").Select
                Range("C17") = d
                Range("C17").Select
                ThisWorkbook.Save
                Workbooks.Open Filename:="C:\Chemin\Fichier d'essais Planning.xls"
                ThisWorkbook.Close
            End If
 
            If reponse = 7 Then
                Sheets("initialisation").Select
                Range("C17") = d
                Range("C17").Select
            End If
        Exit Sub
End Sub

Merci à vous tous pour le coup de main.

Cordialement

jphflo