Sauver fichier et revenir sur le fichier d'origine

[choffraym]

Bonjour,
Je bloque sur ce qui suit :

Je suis dans fichier source A, je fais tourner une macro de mise a jour. Une fois cette mise a jour effectuée, je voudrais

1. Copier ce fichier et le sauver ce fichier dans un repertoire et sous un nom qui sont définis dans une cellule nommee.
2. Desactiver une macro liée a une image appelée picture 5.
3. Cacher une feuille appelée EXTRACT BeX
4. fermer ce fichier et revenir au fichier A.

Pouvez-vous m'aider svp ?
Merci d'avance et bonne journé...
Mike

 

[Pounet95]

Bonsoir
Eventuellement avec ceci !


Sub Macro_Mise_A_Jour()
'
' les instructions de ta macro
'
'Appelle la macro de Copie
Enregistre_Copie
End Sub

Sub Macro_Image5()
MsgBox "Macro active sur l'image"
End Sub

Sub Enregistre_Copie()
Dim NomActuel As String

'Pour r?cup?rer ce fichier apr?s sauvegarde de la copie
NomActuel = ThisWorkbook.Name

'Desactive la macro li?e ? l'image
ActiveSheet.Shapes.Range(Array("Image 5")).Select
Selection.OnAction = ""

'Cache la feuille EXTRACT BeX
Sheets("EXTRACT Bex").Visible = False

'R?cup?re le chemin et le nom de fichier et enregistre
'R?pertoire dans cellule nomm?e NomRep cellule C4
'Nom copie dans cellule nomm?e NomFic cellule D4
ThisWorkbook.SaveAs Range("nomrep") & "\" & Range("nomfic")

'-------------------
'Operations inverses
'-------------------
ThisWorkbook.SaveAs NomActuel

'Reaffecte la macro a l'image 5
ActiveSheet.Shapes.Range(Array("Image 5")).Select
Selection.OnAction = "Macro_Image5"

'Montre la feuille EXTRACT BeX
Sheets("EXTRACT Bex").Visible = True
End Sub

 

[patricktoulon]

bonsoir
c'est pas clair ton truc
en français tu veux faire quoi ?
copier quoi?
ou?

 

[choffraym]

Bonjour,
Merci Pounet95, j'ai fait finalement un peu differemment :

Sub Creation()
'
Dim sPath As String, sFilename As String, sSource As String
Dim Reponse As VbMsgBoxResult

'Teste si repertoire output existe

On Error Resume Next
ChDir Range("CHEMINOUTPUT")
If Err Then MkDir Range("CHEMINOUTPUT") 'pour le créer
On Error GoTo 0


Reponse = MsgBox("Voulez-vous enregistrer les modifications ?", vbYesNo, "Demande de confirmation")
If Reponse = vbNo Then Exit Sub
sPath = Range("CHEMINOUTPUT")
sFilename = Range("FILEOUTPUT")
sSource = Range("CHEMINTOOLSHORT") & "\" & Range("FILETOOL")
With ThisWorkbook
.Save
.ActiveSheet.Shapes.Range(Array("ImageDatabase")).Delete
.ActiveSheet.Shapes.Range(Array("ImageCreation")).Delete
.Sheets("EXTRACT Bex").Visible = False
.SaveAs Filename:=sPath & "\" & sFilename

End With


Workbooks.Open (sSource)

Workbooks(sFilename).Close
End Sub

Merci pour ton aide.
Bat.
Mike