VBA VARIABLE EMPLACEMENT DOSSIER

[JAVERTI]

Bonjour à Tous,

Je vous explique mon problème; J'ai créé un fichier qui va récupérer des photos dans un autre dossier.

Cette macro fonction très bien, mais j'ai besoin de la rendre disponible à un ensemble d'utilisateur...
Du coup pour le moment dans cette macro j'ai une ligne

mon dossier = "C:\users\(monnom)\desktop\(nomdudossier)"


J'aimerai savoir s'il existe une ligne ( ou plusieurs ) de code qui me permettrai de récupérer l'emplacement du dossier à partir de son nom avec l'emplacement en variable!

J'ai pensé à une Userforme qui demanderai à l'utilisateur de récupérer l'emplacement du dossier mais je n'y arrive pas mais surtout il ne faudrait pas qu'il ait à le faire à chaque fois...

En vous remerciant
Javerti

 

[Staple1600]

Bonjour le forum

@>Javerti
Un exemple pour trouver son chemin

Sub Chemins()
MsgBox ActiveWorkbook.Path 'chemin du classeur actif
MsgBox Environ("USERNAME") 'nom de l'utilisateur
MsgBox Environ("USERPROFILE") & "\Desktop" 'chemin du bureau de l'utilisateur actif
End Sub

 

[Jacky67]

Bonjour,
Le code ci-dessous demande à l'utilisateur de définir un répertoire.
Il enregistre le chemin de ce répertoire dans le gestionnaire des noms
Il peut être appelé par son nom ("Emplacement" dans l'exemple) dans la suite de la programmation.

Sub CreationChemin()
Dim Chemin As String
With Application.FileDialog(msoFileDialogFolderPicker)
  'Définit un titre pour la boîte de dialogue
  .Title = "Selectionner un lecteur et un dossier de sauvegarde"
  .Show
  'Affiche le nom du dossier sélectionné
  If .SelectedItems.Count > 0 Then
    Chemin = .SelectedItems(1) & "\"
    ActiveWorkbook.Names.Add Name:="Emplacement", RefersTo:=Chemin
   'Msgbox ==>facutatif
    MsgBox "L'emplacement du dossier choisi est:" & vbLf & Chemin & vbLf & "Il est stoché sous le nom : ''Emplacement'' dans le gestionnaire des noms", , "Information"
    Else
    MsgBox "Abandon", , "information"
  End If
End With
End Sub

.

 

[JAVERTI]

Super merci à vous deux!

Jacky tu as bien compris ce que je voulais faire. Du coup j'ai inséré ton code puis j'ai mis:

mondossier = Emplacement

Mais ça ne fonctionne pas...

Je vous mets mon code complet pour que se soit plus simple:

Sub afficheimage()

Dim mondossier As String
Dim typeimage As String
Dim nomphoto As String


Dim monobjet
Dim Monimage


Dim Chemin As String
With Application.FileDialog(msoFileDialogFolderPicker)
'Définit un titre pour la boîte de dialogue
.Title = "Selectionner le dossier "
.Show
'Affiche le nom du dossier sélectionné
If .SelectedItems.Count > 0 Then
Chemin = .SelectedItems(1) & "\"
ActiveWorkbook.Names.Add Name:="Emplacement", RefersTo:=Chemin
'Msgbox ==>facutatif
MsgBox "L'emplacement du dossier choisi est:" & vbLf & Chemin & vbLf & "Il est stoché sous le nom : ''Emplacement'' dans le gestionnaire des noms", , "Information"
Else
MsgBox "Abandon", , "information"
End If
End With

Set monobjet = ActiveSheet.DrawingObjects

For Each Monimage In monobjet

If Left(Monimage.Name, 7) = "Picture" Then

Monimage.Select
Monimage.Delete

End If

Next

'"C:\users\$$$\desktop\pochette\"

mondossier = Emplacement
nomphoto = Range("b5")
typeimage = ".jpg"

Range("B17").Value = nomphoto
On Error GoTo erreurmessage:

ActiveSheet.Shapes.AddPicture Filename:=mondossier & nomphoto & typeimage, _
linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=45, Top:=50, Width:=200, Height:=200

erreurmessage:
If err.Number = 1004 Then
MsgBox " la photo n'est pas disponible " & vbCrLf & " Vérifier Le code", _
vbInformation + vbOKOnly, "Message d'erreur"
End If

End Sub

 

[Staple1600]

Re, Bonjour Jacky67

Pour le fun, varier les plaisirs, et occuper mon après-midi avant la soirée cinoche.
Une sauvegarde avec CreateObject

Sub Sauvegarde_autre_méthode()
Dim sPath As Object:  Set sPath = Nothing
Set sPath = CreateObject("Shell.Application").BrowseForFolder(0, "Sélectionner votre dossier de sauvegarde,svp", &H1 Or &H200) 'Self.Path
If sPath Is Nothing Then
MsgBox "Sauvegarde annulée!", vbCritical, "Avertissement"
Else
ThisWorkbook.SaveAs sPath.Self.Path & "\" & InputBox("Nom du fichier?", "Saisie du nom du fichier", "svFichier_" & Format(Now, "hhmmss_") & ".xlsm")
End If
Set sPath = Nothing
End Sub

 

[Jacky67]

Super merci à vous deux!

Jacky tu as bien compris ce que je voulais faire. Du coup j'ai inséré ton code puis j'ai mis:

mondossier = Emplacement

Mais ça ne fonctionne pas...

Re....
Essaye avec
mondossier=[Emplacement]

Edit:
Il serait préférable de dissocié le code proposé de la procédure finale.
Il est inutile de demander à chaque fois le nom du répertoire.
Il n'est indispensable qu'une fois (ou quand le chemin du répertoire des photos est modifié) par classeur.
C'est un nom, donc enregistré avec le classeur.

Ensuite pour utiliser ce nom
En vba
Msgbox [Emplacement]
Sur une feuille
=Emplacement

 

[JAVERTI]

Oui excuse moi je revenais pour vous dire que j'avais trouvé... merci beaucoup!!

 

[Staple1600]

Re

@>Javerti
Sinon par curiosité, tu as testé la macro que je te proposais au message#6 ?
Ne serait que pour voir la différence d'allure de la boîte de dialogue affichée ?

 

[Jacky67]

Re

@>Javerti
Sinon par curiosité, tu as testé la macro que je te proposais au message#6 ?
Ne serait que pour voir la différence d'allure de la boîte de dialogue affichée ?

Hello Staple1600
Début du test (xl2007)

 

[Staple1600]

Bonsoir Jacky67

@>Merci d'avoir testé mon code
Mais chez moi pas d'erreur (voir copie d'écran ci-après)

PS: Testé avec Excel 2013 sur W10 64bits