Discussion :

[VELO1222]

Bonjour le forum,
J’ai un problème sur les application.run
Je souhaite à partir d’un fichier de base lancer des application.run afin d’activer les macros des fichiers se trouvant dans un dossier Y, (les fichiers du dossier Y ouvrent des fichiers dans un dossier X copy des cellules et les colles dans les fichiers respectives du dossier Y) les application.run se lancent exécute les macros mais mon problème est que je n’arrive pas a fermer les fichiers du dossier Y en les enregistrant avant fermeture
D’avance merci de votre aide
Cdt
Tony


la programmation du fichier de base

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Lancement()
Application.ScreenUpdating = False
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_1.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_2.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_3.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_4.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_5.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_6.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_7.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_8.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_9.xlm'!entrepot_UVCM"
Application.Run "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_10.xlm'!entrepot_UVCM"
Application.ScreenUpdating = True
End Sub

la programmation des fichiers se trouvant dans le dossier Y

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
Sub entrepot_UVCM()
Application.ScreenUpdating = False
 
 
Sheets("Prix achat-volume").Select
Workbooks.Open Filename:=Range("V2")
 
'vb droit PA
Range("E8:E15").Select
Selection.Copy
Application.Windows("Entrepot_1.xlm").Activate
Sheets("Prix achat-volume").Select
Range("E8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Windows(2).Activate
Application.CutCopyMode = False
 
Application.Windows(1).Activate
ActiveWindow.Close
Application.Windows("Entrepot_1.xlm").Activate
 
End Sub

[Godzestla]

Bonjour,

D'abord je ne comprends pas du tout ce que tu veux faire avec ce code, mais je fais l'impasse la-dessus pour l'instant.

Je ne vois dans ton code aucune instruction pour fermer des fichiers.

Je suppose que le fichier que tu veux fermer est celui qui sera ouvert dans entrepot_UVCM.

Dans ce cas il faut modifier le code de cette manière, si j'ai bien compris ton problème.

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
Sub entrepot_UVCM()
dim wb as workbook
Application.ScreenUpdating = False
 
Sheets("Prix achat-volume").Select
set wb = Workbooks.Open Filename:=Range("V2")
 
'vb droit PA
Range("E8:E15").copy
Application.Windows("Entrepot_1.xlm").Activate
Sheets("Prix achat-volume").Range("E8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Windows(2).Activate
Application.CutCopyMode = False
 
wb.saved = True 'suppose que tu ne veux pas sauver !!!!
wb.close
 
Application.Windows(1).Activate
ActiveWindow.Close
Application.Windows("Entrepot_1.xlm").Activate
 
End Sub

[mayekeul]

bonjour,

si j'ai bien compris

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
Sub entrepot_UVCM()
Dim owb As Workbook
 
Application.ScreenUpdating = False
 
 
Sheets("Prix achat-volume").Select
Set owb = Workbooks.Open(Filename:=Range("V2"))
 
'vb droit PA
owb.Sheets("Prix achat-volume").Range("E8:E15").Copy
Workbooks("Entrepot_1.xlm").Sheets("Prix achat-volume").Range("E8").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
 
owb.Close False
 
ThisWorkbook.Close True
 
End Sub

[VELO1222]

bonjour GODZESTLA, bonjour MAYEKEUL
GODZESTLA j'ai essayé ta proposition mais il apparait une ligne rouge a partir de set wb = Workbooks.Open Filename:=Range("V2")

En revanche MAYEKEUL ca fonctionne que pour le premier fichier les autres fichiers ne s'ouvre meme pas !!
cdt
tony

[mayekeul]

bonjour

En revanche MAYEKEUL ca fonctionne que pour le premier fichier les autres fichiers ne s'ouvre meme pas !!

c'est à dire??

[VELO1222]

Bonjour,
c'est a dire, pour la première Application.run pour le fichier Entrepot_1.xlm les autres non
Cdt

[mayekeul]

bonjour,

et en faisant comme ce ci?

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
Sub entrepot_UVCM()
Dim owb As Workbook
 
Application.ScreenUpdating = False
 
 
Sheets("Prix achat-volume").Select
Set owb = Workbooks.Open(Filename:=Range("V2"))
 
'vb droit PA
owb.Sheets("Prix achat-volume").Range("E8:E15").Copy
Workbooks("Entrepot_1.xlm").Sheets("Prix achat-volume").Range("E8").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
 
owb.Close False
 
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
Sub Lancement()
Dim strMAC As String
Dim I As Integer
 
Application.ScreenUpdating = False
 
For I = 1 To 10
    strMAC = "'C:\Documents and Settings\FRNTO2M\Bureau\TARIFICATION\Entrepots\Entrepot_" & I & ".xlm'!entrepot_UVCM"
    Application.Run strMAC
    Workbooks("Entrepot_" & I & ".xlsm").Close True
Next I
 
Application.ScreenUpdating = True
 
End Sub

[VELO1222]

Bonsoir Mayekeul, bonsoir le forum,
Formidable ca fonctionne Mayekeul grand merci