1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

VBA VARIABLE EMPLACEMENT DOSSIER

Discussion dans 'Forum Excel' démarrée par JAVERTI, 13 Août 2017.

  1. JAVERTI

    JAVERTI XLDnaute Nouveau

    Inscrit depuis le :
    31 Juillet 2017
    Messages :
    12
    "J'aime" reçus :
    0
    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
     
  2. Staple1600

    Staple1600 XLDnaute Barbatruc

    Inscrit depuis le :
    24 Juin 2005
    Messages :
    21370
    "J'aime" reçus :
    704
    Habite à:
    Roahzon
    Utilise:
    Excel 2013 (PC)
    Bonjour le forum

    @>Javerti
    Un exemple pour trouver son chemin
    Code (Visual Basic):
    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
     
  3. Jacky67

    Jacky67 XLDnaute Impliqué

    Inscrit depuis le :
    12 Juin 2016
    Messages :
    662
    "J'aime" reçus :
    93
    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.
    Code (Visual Basic):
    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
    .
     
  4. JAVERTI

    JAVERTI XLDnaute Nouveau

    Inscrit depuis le :
    31 Juillet 2017
    Messages :
    12
    "J'aime" reçus :
    0
    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
     
  5. Staple1600

    Staple1600 XLDnaute Barbatruc

    Inscrit depuis le :
    24 Juin 2005
    Messages :
    21370
    "J'aime" reçus :
    704
    Habite à:
    Roahzon
    Utilise:
    Excel 2013 (PC)
    Re, Bonjour Jacky67

    Pour le fun, varier les plaisirs, et occuper mon après-midi avant la soirée cinoche.
    Une sauvegarde avec CreateObject
    Code (Visual Basic):
    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
     
  6. Jacky67

    Jacky67 XLDnaute Impliqué

    Inscrit depuis le :
    12 Juin 2016
    Messages :
    662
    "J'aime" reçus :
    93
    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
     
    Dernière édition: 14 Août 2017
  7. JAVERTI

    JAVERTI XLDnaute Nouveau

    Inscrit depuis le :
    31 Juillet 2017
    Messages :
    12
    "J'aime" reçus :
    0
    Oui excuse moi je revenais pour vous dire que j'avais trouvé... merci beaucoup!!
     
  8. Staple1600

    Staple1600 XLDnaute Barbatruc

    Inscrit depuis le :
    24 Juin 2005
    Messages :
    21370
    "J'aime" reçus :
    704
    Habite à:
    Roahzon
    Utilise:
    Excel 2013 (PC)
    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 ?
     
  9. Jacky67

    Jacky67 XLDnaute Impliqué

    Inscrit depuis le :
    12 Juin 2016
    Messages :
    662
    "J'aime" reçus :
    93
    Hello Staple1600
    Début du test (xl2007)
    upload_2017-8-13_17-46-32.png
     
  10. Staple1600

    Staple1600 XLDnaute Barbatruc

    Inscrit depuis le :
    24 Juin 2005
    Messages :
    21370
    "J'aime" reçus :
    704
    Habite à:
    Roahzon
    Utilise:
    Excel 2013 (PC)
    Bonsoir Jacky67

    @>Merci d'avoir testé mon code
    Mais chez moi pas d'erreur (voir copie d'écran ci-après)
    BrowseFolder.jpg
    PS: Testé avec Excel 2013 sur W10 64bits
     

Partager cette page