Discussion :

[moa131]

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 :

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

[Kimy_Ire]

Bonjour moa131,

Essaye de remplace ces trois lignes :

Code :

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

1
2
3
Workbooks(Fic18).Activate
Workbooks(Fic18).Save
Workbooks(Fic18).Close

par ceci :

Code :

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

Workbooks(Fic18).Close SaveChanges:=True

J'attends ton retour.

Cordialement,
Kimy

[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

[SfJ5Rpw8]

bonjour,

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

Code :

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

1
2
3
 
dim wk18 as workbook
set wk18=Workbooks.Open (Fic18)

remplace ensuite tous tes

Code :

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

Workbooks(Fic18).

par des

Code :

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

wk18.

[moa131]

Bonjour,

j'ai effectué les modifications suivantes:

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

[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