Gestion automatique vba

2 pièce(s) jointe(s)

bonsoir à tous,
je suis à la recherche d'un code en vba.
j'ai un fichier excell et un dossier comportant du jpeg. quand j'envoie ce classeur et ce dossier, le destinataire à un message d'erreur, car le chemin d'accès pour le dossier jpeg n'est pas le même.
j'aimerai avoir une solution pour que le chemin d'accès change automatiquement.

je n'ai mis qu'un seul jpg a98160.jpg.
en vous remerciant d’avance
Code:

1 2 3 4 5 6 7 Private Sub UserForm_Initialize() Set bdAchat = Sheets("Achat") répertoirePhoto = "C:\Users\PC\Dropbox\victoria\programme\photo\" photo = bdAchat.[A65000].End(xlUp).Row Me.id.List = bdAchat.Range("A2:A" & photo).Value End Sub

Bonjour,

Les photos sont dans le même répertoire que le classeur, si ce n'est pas le cas, demande aux utilisateurs de les y mettre.
Une piste, adapte :
Code:

1 2 3 4 5 6 Dim CheminImg As String Dim NomImage As String NomImage = "MaPhoto.jpg" CheminImg = ThisWorkbook.Path & "\" & NomImage
Hervé.

bonjour hervé

merci de ta réponse aussi rapide, mais j'ai plus de 400 images, aurais-tu une autre idées?

Bonjour,

Plusieurs possibilités dont en voilà deux, soit tu fais une recherche sur tous les disques du PC de l'utilisateur en lui demandant le nom d'une des images (ici, avec InputBox mais tu peux la définir en dur) mais ça peut être long, plusieurs minutes si il y a beaucoup de fichiers, soit tu demande le chemin du dossier contenant les images. Dans les deux cas, ceci n'est fait qu'une fois à la première ouverture du classeur.
Pour la recherche sur les lecteurs :
A mettre dans un module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 
Declare Function SearchTreeForFile _
        Lib "IMAGEHLP.DLL" ( _
        ByVal Lecteur As String, _
        ByVal Fichier As String, _
        ByVal RetourChemin As String) As Long
 
Public Chemin As String
 
Sub ChercherFichier()
 
    Dim Fichier As String
    'va d'abords chercher le chemin dans le nom
    'une erreur est générée si inexistant
 
    On Error Resume Next
    Chemin = Left(Right(ActiveWorkbook.Names("Chemin").Value, _
                  Len(ActiveWorkbook.Names("Chemin").Value) - 2), _
                  Len(ActiveWorkbook.Names("Chemin").Value) - 3)
 
    'si erreur, recherche sur les disques ce qui peut prendre
    'pas mal de temps car tous les lecteurs sont passés en revu..!
    If Err.Number <> 0 Then
 
        Fichier = InputBox("Veuillez indiquer le nom du fichier avec son extension à chercher dans le PC !" _
                           & vbCrLf & _
                           "Attention, ceci peut prendre plusieurs minutes", "Recherche de fichier.")
 
        If Fichier = "" Then Exit Sub
 
        Chemin = Dossiers(Fichier)
 
        'si le fichier a été trouvé, stocke le chemin dans un nom
        If Chemin <> "" Then
 
            ThisWorkbook.Names.Add "Chemin", Chemin
 
        Else
 
            MsgBox "Fichier introuvable !"
 
        End If
 
    End If
 
End Sub
 
Public Function Dossiers(Fichier As String) As String
 
    Dim Fso As Object
    Dim Lect As Object
    Dim Pos As Long
    Dim Retour As Boolean
    Dim Tampon As String
 
    If Fichier = "" Then
 
        MsgBox "Vous devez préciser le fichier à chercher avec son extension !", , "Recherche de fichier."
 
        Exit Function
 
    End If
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
    For Each Lect In Fso.Drives
 
        Tampon = Space(255)
 
        Retour = SearchTreeForFile(Lect & "\", Fichier, Tampon)
 
        If Retour = True Then
 
            Pos = InStr(Tampon, Chr(0))
 
            If Pos <> 0 Then
 
                Tampon = Left(Tampon, Pos - 1)
 
            End If
 
            Dossiers = Left(Tampon, InStrRev(Tampon, "\"))
 
            Exit Function
 
        End If
 
    Next Lect
 
End Function

A mettre dans le module du classeur :

Code:

1
2
3
4
5
6
 
Private Sub Workbook_Open()
 
    ChercherFichier
 
End Sub

Pour la demande du dossier :
A mettre dans un module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
Public Chemin As String
 
Sub Dossier()
 
    Dim Fichier As String
    'va d'abords chercher le chemin dans le nom
    'une erreur est générée si inexistant
    On Error Resume Next
    Chemin = Left(Right(ActiveWorkbook.Names("Chemin").Value, _
                  Len(ActiveWorkbook.Names("Chemin").Value) - 2), _
                  Len(ActiveWorkbook.Names("Chemin").Value) - 3)
 
    'si erreur, recherche sur les disques ce qui peut prendre
    'pas mal de temps car tous les lecteurs sont passés en revu..!
    If Err.Number <> 0 Then
 
        On Error GoTo 0
 
        With Application.FileDialog(4)
 
            .Show
 
            On Error Resume Next 'si annuler
 
            Chemin = .SelectedItems(1)
 
            If Chemin <> "" Then
 
                ThisWorkbook.Names.Add "Chemin", Chemin & "\"
 
            End If
 
        End With
 
    End If
 
End Sub

A mettre dans le module du classeur :

Code:

1
2
3
4
5
6
 
Private Sub Workbook_Open()
 
    Dossier
 
End Sub

Tu n'as ensuite plus qu'à utiliser la variable publique "Chemin" pour charger tes images.

Hervé.

bonjour,
un seul mot MAGNIFIQUE

un tout grand merci à toi

bon wk