XL 2010 VBA Boite de dialogue Ouvrir et Enregistrer sous

[jl456]

Bonjour,

J'ai créé un classeur excel avec macro VBA "Simulation1" qui récupère les données d'un classeur "requete1".
Pour ce faire, j'ouvre une boite de dialogue pour pointer le fichier source.

Question 1 : Plutôt que d'inscrire en dur le chemin d'accès de "requete1" est-il possible de modifier le code pour pointer le dossier où se trouve "simulation1" car "requete1" et "simulation1" seront toujours dans le même dossier, quel qu'il soit ?

Question 2 : j'ai voulu ajouter un abandon de macro si par exemple on souhaite cliquer sur "annuler" au moment de pointer le classeur "requete1" mais j'ai une erreur de code, pouvez-vous m'aider ?

Question 3 : une fois l'importation terminée et le message "Mise à jour terminée" validé, je voudrais qu'une boite de dialogue "enregistrer sous" s'ouvre en pointant le dossier de simulation1 et propose d'enregistrer le classeur en pré-documentant "simulation1 + &Année&Mois&Jour".

Je vous remercie d'avance pour votre aide.

Sub Chargement_requete_1()
Dim nomextract_requete As String
Dim nommacro As String

Application.ScreenUpdating = False

'*********************Enregistrement du nom du classeur***************************
nommacro = ActiveWorkbook.Name

'*********************Chemin d'accés au fichier***********************************
ChDrive "I"
ChDir "I:\ Tab_de_Bord\ "

'*********************Pointer Requete Source****************************
MsgBox "Pointer le fichier Requete1", vbOKOnly, "ALERTE"
requete_1 = Application _
.GetOpenFilename("Fichier Excel (*.xls), *.xls", , "Pointer le fichier Requete1", , False)
If requete_1 = False Then GoTo Abandon

'*********************Ouverture Requete 1**************************
Workbooks.Open Filename:=requete_1
nomextract_requete = ActiveWorkbook.Name
Application.DisplayAlerts = False

'*********************RAZ des onglets de Simulation 1****
Windows(nommacro).Activate
Sheets("A").Select
    Cells.Select
    Selection.ClearContents
    Selection.Borders.LineStyle = xlNone
    With Selection.Interior
        .Pattern = xlNone
    End With

'*************Transfert des données du fichier requete1 au fichier simulation1*************
Windows(nomextract_requete).Activate
    Sheets("A").Select
    Cells.Select
    Selection.Copy
Windows(nommacro).Activate
    Sheets("A").Select
    Cells.Select
    ActiveSheet.Paste

Workbooks(nomextract_requete).Close
MsgBox "Mise à jour terminée", vbOKOnly, "ALERTE"

End Sub

JL

 

[thebenoit59]

Re : VBA Boite de dialogue Ouvrir et Enregistrer sous

Bonjour JL.

Si ton fichier requete est dans la même dossier que le fichier simulation, il ne doit pas y avoir nécessité de pointer le dossier, on peut directement récupérer la racine.

Sub Chargement_requete_1()
Dim nomextract_requete As Workbook, nommacro As Workbook

Application.ScreenUpdating = False

'*********************Enregistrement du nom du classeur***************************
Set nommacro = ActiveWorkbook
dossier = ThisWorkbook.Path

'*********************Ouverture Requete 1**************************
Set nomextract_requete = Workbooks.Open(dossier & "\requete_1.xls")
Application.DisplayAlerts = False

'*********************RAZ des onglets de Simulation 1****
With nommacro.Sheets("A").Cells
    .ClearContents
    .Borders.LineStyle = xlNone
    .Interior.Pattern = xlNone
End With

'*************Transfert des données du fichier requete1 au fichier simulation1*************
nomextract_requete.Sheets("A").Cells.Copy nommacro.Sheets("A").Range("A1")
nomextract_requete.Close False

MsgBox "Mise à jour terminée", vbOKOnly, "ALERTE"

'*************Ouverture de la fenêtre "Enregistrer sous"*************
nomFichier = dossier & "\simulation 1 " & Format(Date, "yyyy-mm-dd") & ".xls"
Application.Dialogs(xlDialogSaveAs).Show (nomFichier)

End Sub

 

[jl456]

Re : VBA Boite de dialogue Ouvrir et Enregistrer sous

Bonsoir,

Merci pour votre aide.

JL