[XL-2003] Sauvegarder fichier sous conditions [Résolu]

lilou86 · 16/08/2011, 10h36

Bonjour à tous,

J'ai un petit soucis avec mon code mais je n'arrive pas à voir où se situe le problème.

Le but du code est de sauvegarder un fichier sous différentes conditions :
- si c'est le fichier support, il doit être sauvegarder sous un certain format "NomFichier" dans 2 dossiers différents "CheminMatiere" et CheminDiffusion" ==> Cette partie est OK !
- si le fichier dans le dossier Diffusion est modifié, le fichier dans le dossier Matière doit être modifié aussi ==> Cette partie ne fonctionne pas !
- si le fichier dans le dossier Matière est modifié, le fichier dans le dossier Diffusion doit être modifié aussi ==> Cette partie est OK !

Voici le 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
Sub SAUVEGARDE()
 
Dim NomFichier As String
Dim CheminMatiere As String
Dim CheminDiffusion As String
 
NomFichier = Worksheets("DIFFUSION").Range("B15") & "- Lot n°" & Worksheets("DIFFUSION").Range("C22") & " du " & Worksheets("DIFFUSION").Range("C20") & ".xls"
CheminMatiere = "M:\QC\2_MESURES\24_Résultats labo\NOUVELLE ARBORESCENCE\245_TESTS ECHANTILLONS POUDRES\2453_NOIR DE FUMEE\RESULTATS\"
CheminDiffusion = "M:\QC\2_MESURES\24_Résultats labo\NOUVELLE ARBORESCENCE\241_GESTION DES ESSAIS LABO\2413_DIFFUSION DES RESULTATS\"
 
'SAUVEGARDE SI FICHIER DANS DOSSIER MATIERE OUVERT
If Dir(CheminMatiere & NomFichier, vbNormal) = NomFichier Then 'ActiveWorkbook.Name = NomFichier And
    ActiveWorkbook.Save
    Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists(CheminDiffusion & NomFichier) Then
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set f = fs.GetFile(CheminDiffusion & NomFichier)
            f.Delete
            ActiveWorkbook.SaveAs Filename:=CheminDiffusion & NomFichier
        Else
            ActiveWorkbook.SaveAs Filename:=CheminDiffusion & NomFichier
        End If
'SAUVEGARDE SI FICHIER DANS DOSSIER DIFFUSION OUVERT
ElseIf Dir(CheminDiffusion & NomFichier, vbNormal) = NomFichier Then 'ActiveWorkbook.Name = NomFichier And
    ActiveWorkbook.Save
    Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists(CheminMatiere & NomFichier) Then
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set f = fs.GetFile(CheminMatiere & NomFichier)
            f.Delete
            ActiveWorkbook.SaveAs Filename:=CheminMatiere & NomFichier
        Else
            ActiveWorkbook.SaveAs Filename:=CheminMatiere & NomFichier
        End If
'SAUVEGARDE DU FICHIER SUPPORT
Else
    ActiveWorkbook.SaveAs Filename:=CheminMatiere & NomFichier
    ActiveWorkbook.SaveAs Filename:=CheminDiffusion & NomFichier
End If
 
Application.Quit
 
End Sub

Merci d'avance pour toute l'aide que vous pourrez m'apporter.

Bonne journée à vous tous !

patricktoulon · 16/08/2011, 14h00

bonjour

ou lalala!!!!

dis moi tu n'a pas l'impression de pedaler pour rien toi

tu créé tes deux chemin c'est bon

tu cré deux variable
chemin de l'actif et chemin final et une simple condition sur l'un ou l'autre

(avec le bloquage des fenetre etes vous sur ect....)

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
 
Sub SAUVEGARDE()
 Application.DisplayAlerts = False
Dim NomFichier As String
Dim CheminMatiere As String, CheminDiffusion As String, chemin_de_l_actif As String, chemin_final As String
 
NomFichier = Worksheets("DIFFUSION").Range("B15") & "- Lot n°" & Worksheets("DIFFUSION").Range("C22") & " du " & Worksheets("DIFFUSION").Range("C20") & ".xls"
 
CheminMatiere = "M:\QC\2_MESURES\24_Résultats labo\NOUVELLE ARBORESCENCE\245_TESTS ECHANTILLONS POUDRES\2453_NOIR DE FUMEE\RESULTATS\"
CheminDiffusion = "M:\QC\2_MESURES\24_Résultats labo\NOUVELLE ARBORESCENCE\241_GESTION DES ESSAIS LABO\2413_DIFFUSION DES RESULTATS\"
 
chemin_de_l_actif = ThisWorkbook.Path
 
 
If chemin_de_l_actif = CheminMatiere Then
 
chemin_final = CheminDiffusion
 
'ici ton code pour sauver
 
ElseIf chemin_de_l_actif = CheminDiffusion Then
chemin_final = CheminMatiere
'ici ton autre code pour sauver
 
End If
Application.DisplayAlerts = True
End Sub

au plaisir

lilou86 · 16/08/2011, 15h27

Pour commencer, merci pour votre aide.

Je n'arrive toujours pas à le faire tourner. Mais j'ai sans doute mal compris les lignes

Citation:

ici ton code pour sauver

Voici le code avec les lignes en plus :

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
Sub SAUVEGARDE()
 
Application.DisplayAlerts = False
 
Dim NomFichier As String
Dim CheminMatiere As String, CheminDiffusion As String, chemin_de_l_actif As String, chemin_final As String
 
NomFichier = Worksheets("DIFFUSION").Range("B15") & "- Lot n°" & Worksheets("DIFFUSION").Range("C22") & " du " & Worksheets("DIFFUSION").Range("C20") & ".xls"
 
CheminMatiere = "M:\QC\2_MESURES\24_Résultats labo\NOUVELLE ARBORESCENCE\245_TESTS ECHANTILLONS POUDRES\2453_NOIR DE FUMEE\RESULTATS\"
CheminDiffusion = "M:\QC\2_MESURES\24_Résultats labo\NOUVELLE ARBORESCENCE\241_GESTION DES ESSAIS LABO\2413_DIFFUSION DES RESULTATS\"
 
chemin_de_l_actif = ThisWorkbook.Path
 
 
If chemin_de_l_actif = CheminMatiere Then
    chemin_final = CheminDiffusion
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:=CheminDiffusion & NomFichier
 
ElseIf chemin_de_l_actif = CheminDiffusion Then
    chemin_final = CheminMatiere
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:=CheminMatiere & NomFichier
 
Else
    ActiveWorkbook.SaveAs Filename:=CheminMatiere & NomFichier
    ActiveWorkbook.SaveAs Filename:=CheminDiffusion & NomFichier
 
End If
 
Application.DisplayAlerts = True
 
Application.Quit
 
End Sub

Qu'est ce que vous entendez par

Citation:

(avec le bloquage des fenetre etes vous sur ect....)

Merci d'avance.

Bonne journée.

patricktoulon · 17/08/2011, 14h46

bonjour

finalement tu dis :

Citation:

- si le fichier dans le dossier Diffusion est modifié, le fichier dans le dossier Matière doit être modifié aussi ==> Cette partie ne fonctionne pas !
- si le fichier dans le dossier Matière est modifié, le fichier dans le dossier Diffusion doit être modifié aussi ==> Cette partie est OK !

alors a quoi sa sert de metre des conditions fait le directement

sauve les deux directement !!!!!

essaie de résoner logiquement.....

au plaisir

lilou86 · 17/08/2011, 18h49

En combinant votre code et le mien j'ai trouvé la solution.

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
Sub SAUVEGARDE()
 
Dim NomFichier As String
Dim CheminMatiere As String
Dim CheminDiffusion As String
Dim CheminActif As String
 
NomFichier = Worksheets("DIFFUSION").Range("B15") & "- Lot n°" & Worksheets("DIFFUSION").Range("C22") & " du " & Worksheets("DIFFUSION").Range("C20") & ".xls"
CheminMatiere = "M:\QC\2_MESURES\24_Résultats labo\NOUVELLE ARBORESCENCE\245_TESTS ECHANTILLONS POUDRES\2453_NOIR DE FUMEE\RESULTATS\"
CheminDiffusion = "M:\QC\2_MESURES\24_Résultats labo\NOUVELLE ARBORESCENCE\241_GESTION DES ESSAIS LABO\2413_DIFFUSION DES RESULTATS\"
 CheminActif = ActiveWorkbook.path & "\"
 
'SAUVEGARDE SI FICHIER DANS DOSSIER MATIERE OUVERT
If CheminMatiere = CheminActif Then
    ActiveWorkbook.Save
    Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists(CheminDiffusion & NomFichier) Then
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set f = fs.GetFile(CheminDiffusion & NomFichier)
            f.Delete
            ActiveWorkbook.SaveAs Filename:=CheminDiffusion & NomFichier
        Else
            ActiveWorkbook.SaveAs Filename:=CheminDiffusion & NomFichier
        End If
'SAUVEGARDE SI FICHIER DANS DOSSIER DIFFUSION OUVERT
ElseIf CheminDiffusion = CheminActif Then 
    ActiveWorkbook.Save
    Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists(CheminMatiere & NomFichier) Then
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set f = fs.GetFile(CheminMatiere & NomFichier)
            f.Delete
            ActiveWorkbook.SaveAs Filename:=CheminMatiere & NomFichier
        Else
            ActiveWorkbook.SaveAs Filename:=CheminMatiere & NomFichier
        End If
'SAUVEGARDE DU FICHIER SUPPORT
Else
    ActiveWorkbook.SaveAs Filename:=CheminMatiere & NomFichier
    ActiveWorkbook.SaveAs Filename:=CheminDiffusion & NomFichier
End If
 
Application.Quit
 
End Sub

C'est peut-être un peu compliqué mais cela fonctionne.

Merci pour votre aide précieuse.

Bonne soirée.

patricktoulon · 17/08/2011, 19h49

re
bonjour

ton code n'a rien de compliqué par contre INUTILE sans vouloir t'offenser

tu n'a pas pris en compte ma derniere remarque c'est bien domage
ca t'aurait evider de pedaler pour rien

je repete donc mon raisonnement

si c'est un chemin alors enregistrer aussi dans l'autre chemin

et vice et verca

si tu ne vois pas ton souci il va te faloir revoir ta logique

enleve toute les condition et sauve les deux classeur d'un coup dans leur chemin respectifs

au plaisir

17/08/2011, 19h49	#6
patricktoulon Expert Confirmé patrick Inscription : avril 2009 Messages : 1 829 Détails du profil Informations personnelles : Nom : patrick Âge : 42 Localisation : France, Var (Provence Alpes Côte d'Azur) Informations professionnelles : Secteur : Bâtiment Informations forums : Inscription : avril 2009 Messages : 1 829 Points : 2 857 Points : 2 857	re re bonjour ton code n'a rien de compliqué par contre INUTILE sans vouloir t'offenser tu n'a pas pris en compte ma derniere remarque c'est bien domage ca t'aurait evider de pedaler pour rien je repete donc mon raisonnement si c'est un chemin alors enregistrer aussi dans l'autre chemin et vice et verca si tu ne vois pas ton souci il va te faloir revoir ta logique enleve toute les condition et sauve les deux classeur d'un coup dans leur chemin respectifs au plaisir __________________ mes fichiers dans les contributions: mon formulaire mail avec CDO en vba et mon formulaire mail avec CDO en vbs dans un HTA mon nouveau mouse in out pour les boutons dans un userform mon addin pour prendre un cliché de selection de cellules si ton problème est résolu n'oublie pas de pointer :résolu:ça peut servir aux autres et n'oublie pas de voter
	00

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email