erreur d'exécution 1004

Version imprimable

Bonjour,
je suis débutant en VBA, et j'ai commencé a faire une macro permettant de copier la ligne d'un classeur sur un autre si celles-ci sont différentes l'une de l'autre, cependant quand j'execute ma fonction j'ai une erreur 1004 la méthode close de l'objet workbook a échoué, pouvez vous m'aider svp ?

Voici le bout de code:

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
Dim Fic18 As String

Fic18 = "XX.xls"
Sh18 = "XX"

Workbooks.Open (Fic18)
If ActiveSheet.ProtectContents = True Then

    Workbooks(Fic18).Worksheets(Sh18).Unprotect Password:="xxxxxxx"

     etaitprotege = 1

End If

                            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

For Ligne = 3 To Max

     If Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("K" & Ligne) = "S" Then

          Num = Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("J" & Ligne).Value

          If Num > 0 And Not IsEmpty(Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("J" & Ligne)) Then
                R = Num

          End If

                             ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

            Work = Workbooks(Fic18).Worksheets(Sh18).Range("G" & R)
            Depart = Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("G" & Ligne)
            Tech2 = Workbooks(Fic18).Worksheets(Sh18).Range("I" & R)
            Tech1 = Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("I" & Ligne)
            com1 = Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("L" & Ligne)
            com2 = Workbooks(Fic18).Worksheets(Sh18).Range("L" & R)


                                ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

            If Depart <> Work Then
                    Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("G" & Ligne).Copy Workbooks(Fic18).Worksheets(Sh18).Range("G" & R)

                               
            End If

            If com1 <> com2 Then
                Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("L" & Ligne).Copy Workbooks(Fic18).Worksheets(Sh18).Range("L" & R)
                           
            End If

            If Tech1 <> Tech2 Then
                Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("I" & Ligne).Copy Workbooks(Fic18).Worksheets(Sh18).Range("I" & R)
                         

            End If

            If IsEmpty(Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("K" & Ligne)) Then
                
                Exit For
            End If
        End If

Next Ligne
    
If etaitprotege = 1 Then

       Workbooks(Fic18).Worksheets(Sh18).Protect Password:="xxxxxxxx"
       etaitprotege = 0

End If
        
                Workbooks(Fic18).Activate
                Workbooks(Fic18).Save
                Workbooks(Fic18).Close

le débugger me surligne celle que j'ai souligné/gras/italique

Vous en remerciant

moa131

24/04/2014, 11h30
Kimy_Ire
Bonjour moa131,

Essaye de remplace ces trois lignes :
Code:

1 2 3 Workbooks(Fic18).Activate Workbooks(Fic18).Save Workbooks(Fic18).Close
par ceci :

Code:

Workbooks(Fic18).Close SaveChanges:=True

J'attends ton retour. :ccool:

Cordialement,
Kimy
24/04/2014, 13h13
moa131

Bonjour,

merci d'avoir pris le temps de répondre,
votre solution ne fonctionne pas :(

PS: je précise aussi que cet macro s'active lorsque j'appuie sur un bouton dans mon useform, je pense que le probleme doit venir de la car dans un Sub Before_Save() la macro fonctionne parfaitement (je l'ai enlevé du before save car j'ai un message d'erreur me disant que la procédure est trop longue, j'ai donc décidé de la scinder en deux executable sur le clic de deux boutons différents d'un useform

Merci
Cordialement
moa131
24/04/2014, 13h45
SfJ5Rpw8
bonjour,

utilise une variable workbook pour accéder à ton fichier , pour cela déclare la variable
Code:

1 2 3 dim wk18 as workbook set wk18=Workbooks.Open (Fic18)
remplace ensuite tous tes

Code:

Workbooks(Fic18).

par des

Code:

wk18.

Bonjour,

j'ai effectué les modifications suivantes:

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
93
94
95
96
97
98
99
     Application.DisplayAlerts = False
Dim Fic18 As String
 
Fic18 = "XX.xls"
Sh18 = "XX"    
 
 
        Dim Num As Integer
        Dim R As Integer
        Dim Max As Integer
 
        Max = 1900
        Num = 2
        R = 1
 
        Dim wk18 As Workbook
        Set wk18 = Workbooks.Open(Fic18)
 
 
                                                                             ''''''''''''''''''' SSSSSSSSSSSSSSSS ''''''''''''''''''''''''''''''''
 If ActiveSheet.ProtectContents = True Then
     'MsgBox "True"
    wk18.Worksheets(Sh18).Unprotect Password:="wwwwww"
 
     etaitprotege = 1
End If
 
                            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
        For Ligne = 3 To Max
 
        'MsgBox (e)
        'MsgBox (Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("K" & Ligne) = "B")
 
          If Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("K" & Ligne) = "S" Then
            'MsgBox (Ligne)
            'MsgBox (Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("K" & Ligne))
                Num = Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("J" & Ligne).Value
                      'MsgBox ("For")
                      'MsgBox (Num)
            If Num > 0 And Not IsEmpty(Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("J" & Ligne)) Then
                R = Num
                    'MsgBox (R)
 
            'Else
            '    Exit For
            End If
 
                             ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
            'MsgBox (e)
 
            Work = wk18.Worksheets(Sh18).Range("G" & R)
            Depart = Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("G" & Ligne)
            Tech2 = wk18.Worksheets(Sh18).Range("I" & R)
            Tech1 = Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("I" & Ligne)
            com1 = Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("L" & Ligne)
            com2 = wk18.Worksheets(Sh18).Range("L" & R)
 
                            'MsgBox (Depart)
                            'MsgBox(Work)
 
                                ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
            If Depart <> Work Then
                    Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("G" & Ligne).Copy wk18.Worksheets(Sh18).Range("G" & R)
 
                                'MsgBox (e)
            End If
 
            If com1 <> com2 Then
                Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("L" & Ligne).Copy wk18.Worksheets(Sh18).Range("L" & R)
                                'MsgBox ("Mise à jour commentaires effectué")
                                'MsgBox (e)
            End If
 
            If Tech1 <> Tech2 Then
                Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("I" & Ligne).Copy wk18.Worksheets(Sh18).Range("I" & R)
                                'MsgBox ("Mise à jour techniciens effectué")
                                'MsgBox (e)
 
            End If
 
            If IsEmpty(Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Range("K" & Ligne)) Then
                '''MsgBox ("Exit")
                Exit For
            End If
        End If
 
    Next Ligne
 
        If etaitprotege = 1 Then
                   wk18.Worksheets(Sh18).Protect Password:="xxxxx"
                    etaitprotege = 0
        End If
 
                wk18.Activate
                wk18.Save
                wk18.Close

avec cette modification, cela ne marche toujours pas :(

PS: Vous trouverez ici la partie de code qui agis avec le userform (c'est un code un peu bourrin je ne savais pas faire autrement :( )
Merci

Cordialement

moa131

24/04/2014, 14h18
SfJ5Rpw8

C'est bien sur la ligne .Close l'erreur ?

as tu du code dans la fonction événementielle "before close" de ton classeur 18

Oui dans le before close j'ai:
Code:

1 2 3 4 5 6 7 Application.WindowState = xlMinimized UserForm1.Show vbModeless Application.DisplayAlerts = False Workbooks("Récapitulatif.xls").Worksheets("Feuil1").Cells.Clear ThisWorkbook.Save Application.DisplayAlerts = True
Vba surligne en jaune la ligne wk18.close

PS: Vous trouverez ici la partie de code qui agis avec le userform (c'est un code un peu bourrin je ne savais pas faire autrement )
Merci

25/04/2014, 09h53
moa131

Bon, j'ai trouvé une solution, j'ai mis dans deux fonctions différentes les codes associés au bouton 1 et 2 et j'appelle les deux fonctions dans un Sub Before_Close(), ca marche super, tant pis pour mon idée des boutons :(