Répertoire par défaut lors d'un enregistrement (VBA)

Bonjour,

J'ai cette macro qui permets à l'utilisateur de sauvegarder une copie du fichier dans le répertoire de son choix.

J'aimerais qu'un chemin par défaut soit déjà tracé lorsque l'utilisateur arrive sur cette boite de dialogue (mais je ne sais pas comment rajouter cela dans la partie du code qui correspond à l'enregistrement -voir ci-dessous-).

191207063920663431
Sub Reinitialisation_Fichier()
    Dim Nbr As Variant
    Dim AdresseCell As Variant

    Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String, NomComplet As String

    'On fait une sauvegarde du fichier avant réinitialisation
    '.xlsm = 5
    '.xls = 4

    date_archive = Replace(Range("A5").Value, "/", "-")

    wk = ActiveWorkbook.Name
    LeNom = Left(wk, Len(wk) - 5) & " (" & date_archive & ")" & ".xlsm" 'A adapter

        Set objShell = CreateObject("Shell.Application")

recommence:

Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire pour sauvegarder votre archive.", &H1&)

        On Error Resume Next
        Set oFolderItem = objFolder.Items.Item
        Chemin = oFolderItem.Path

            If Chemin = "" Then
            MsgBox "Le répertoire que vous avez choisi n'est pas valide."
            GoTo recommence
            End If

    ActiveWorkbook.SaveCopyAs Chemin & "\" & LeNom   'à adapter

    MsgBox "Une copie de votre classeur a bien été enregistrée dans le répertoire que vous avez choisi." & Chr(10) & Chr(10) & _
    "Le fichier " & ActiveWorkbook.Name & " va maintenant être réinitialisé. Cette opération peut durer quelques minutes."
End Sub

Merci d'avance pour votre aide,

Bapt

Bonjour,

En ajoutant le chemin complet ... (Mais, il semble que ça n'accepte pas de variable.)

Set objFolder = objShell.BrowseForFolder(0, "Choisir un répertoire pour sauvegarder votre archive.", 0, "C:\Users\horusbk\Desktop\Baptiste\")

ric

Bonsoir Ric, merci de ton aide.

Qu'entends-tu par ça "n'accepte pas de variables" ? Tu veux dire stocker la racine du dossier dans une variable ?

Bapt.

Bonjour,

Pour remplacer "C:\Users\horusbk\Desktop\Baptiste\" par une variable qui contiendrait le chemin.

Mes quelques tests ne fonctionnaient pas avec une variable.

Ceci ne fonctionnait pas.

Chemin = "C:\Users\horusbk\Desktop\Baptiste\"

Set objFolder = objShell.BrowseForFolder(0, "Choisir un répertoire pour sauvegarder votre archive.", 0, Chemin)

Ça donne toujours le profil utilisateur ... si mon souvenir est bon.

ric

Re

D'accord je comprends mieux !

Néanmoins avec cette solution l'utilisateur est forcé d'enregistrer dans le chemin que j'ai spécifié dans le codage VBA. Est-il possible que la boite de dialogue affiche le dernier dossier du chemin que j'ai indiqué dans le code mais en laissant tout de même à l'utilisateur la liberté d'en choisir un nouveau ? (comme cela est possible lorsqu'on enregistre sur Excel ou tout autre programme par exemple).

mini 191207085646406804

Allô!

J'ai cherché sur le Net ... sans succès.

Peut-être qu'un formeur ayant plus d'expérience que moi aura une solution.

ric

Pas de soucis Ric Merci déjà pour ton aide !

Je vais rechercher également de mon côté au cas où ^^

Par contre ce qui est bizarre, c'est qu'en rajoutant la racine par défaut, plus rien n'est enregistré dans mon dossier :/

Bapt

Bonjour,

Regarde ceci ... si cela peut convenir ...

Sub SelectFolder4()
Dim sFolder As String
    ' Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\Users\horusbk\Desktop\Baptiste\"
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        End If
    End With

    If sFolder <> "" Then ' if a file was chosen
        ' *********************
        ' put your code in here
        ' *********************
    End If
End Sub

ric

Problème résolu !

J'ai adapté mon code avec celui que tu m'as donné et tout fonctionne.

Le voici si ça peut en aider d'autres

    Dim Nbr As Variant
    Dim AdresseCell As Variant

    Dim Chemin As String, NomComplet As String, sFolder As String

    'On fait une sauvegarde du fichier avant réinitialisation
    '.xlsm = 5
    '.xls = 4

    date_archive = Replace(Range("A5").Value, "/", "-")

    wk = ActiveWorkbook.Name
    LeNom = Left(wk, Len(wk) - 5) & " (" & date_archive & ")" & ".xlsm" 'A adapter

    ' Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "ici votre racine de destination" 'A adapter
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        End If
    End With

    If sFolder <> "" Then ' if a file was chosen
    End If

    Chemin = sFolder

    ActiveWorkbook.SaveCopyAs Chemin & "\" & LeNom   'à adapter

    MsgBox "Une copie de votre classeur a bien été enregistrée dans le répertoire que vous avez choisi." & Chr(10) & Chr(10) & _
    "Le fichier " & ActiveWorkbook.Name & " va maintenant être réinitialisé. Cette opération peut durer quelques minutes."

Bapt.

Rechercher des sujets similaires à "repertoire defaut lors enregistrement vba"