Chargement image

Bonjour tous le monde !

Quand j'utilise mon formulaire sur mon ordinateur, pas de probleme j'arrive à afficher les images.

Cependant, lorsque j'utilise le formulaire sur un autre PC, j'ai un message d'erreur, car ce n'est plus le bon lien des images, pouvez-vous m'aider, je bloque depuis un bon moment.

MERCI

Private Sub societe_Change()

Dim Emplacement As Range
Dim Img As Object
Dim ShapeObj As Shape
Dim i As Integer
Dim nomLogo(1 To 16) As String
Dim nomSociete(1 To 16) As String

nomLogo(1) = "F:\User\XXX\IMG\Entreprises\Alpha métal"
nomLogo(2) = "F:\User\XXX\IMG\Entreprises\CNNMCO.JPG"
nomLogo(3) = "F:\User\XXX\IMG\Entreprises\Damen.JPG"
nomLogo(4) = "F:\User\XXX\IMG\Entreprises\DCNS.JPG"
nomLogo(5) = "F:\User\XXX\IMG\Entreprises\Dehimi.gif"
nomLogo(6) = "F:\User\XXX\IMG\Entreprises\eads.JPG"
nomLogo(7) = "F:\User\XXX\IMG\Entreprises\Eiffel.JPG"
nomLogo(8) = "F:\User\XXX\IMG\Entreprises\IDP.gif"
nomLogo(9) = "F:\User\XXX\IMG\Entreprises\IUT.jpg"
nomLogo(10) = "F:\User\XXX\IMG\Entreprises\métalform.JPG"
nomLogo(11) = "F:\User\XXX\IMG\Entreprises\Navtis.JPEG"
nomLogo(12) = "F:\User\XXX\IMG\Entreprises\Oxymax.JPG"
nomLogo(13) = "F:\User\XXX\IMG\Entreprises\Piriou.JPG"
nomLogo(14) = "F:\User\XXX\IMG\Entreprises\Sneff.JPG"
nomLogo(15) = "F:\User\XXX\IMG\Entreprises\Sobe.JPG"
nomLogo(16) = "F:\User\XXX\IMG\Entreprises\sofresid.JPG"

nomSociete(1) = "Alpha métal"
nomSociete(2) = "CNN MCO"
nomSociete(3) = "Damen"
nomSociete(4) = "DCNS"
nomSociete(5) = "Dehimi"
nomSociete(6) = "EADS"
nomSociete(7) = "Eiffel"
nomSociete(8) = "IDP"
nomSociete(9) = "IUT"
nomSociete(10) = "Métalform"
nomSociete(11) = "Navtis"
nomSociete(12) = "Oxymax"
nomSociete(13) = "Piriou"
nomSociete(14) = "Snef"
nomSociete(15) = "Sobec"
nomSociete(16) = "Sofresid"

 Dim Shp As Shape
For i = 1 To 16
    If societe.Value = nomSociete(i) Then
      Image1.Picture = LoadPicture(nomLogo(i))

    '######################################
    'POUR L'INSERER DANS LA FEUIL1
    '######################################
        'Définit l'emplacement de l'image
        Set Emplacement = Range("A1:B3")
        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
        With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
            .Name = "Cible"
        End With
        ActiveSheet.Shapes("Cible").Delete
        Set Shp = Feuil2.Shapes.AddPicture(nomLogo(i), msoFalse, msoCTrue, 100, 0, 70, 50)

    End If
Next i

 End Sub

Bonjour,

si tu mets les fichiers dans le même réperrtoire que le classeur tu peux adapter le code de la manière suivante :

à tester

Private Sub societe_Change()

Dim Emplacement As Range
Dim Img As Object
Dim ShapeObj As Shape
Dim i As Integer
Dim nomLogo(1 To 16) As String
Dim nomSociete(1 To 16) As String
chemin = ThisWorkbook.Path
If chemin <> "" Then chemin = chemin & "\"

nomLogo(1) = chemin & "Alpha métal"
nomLogo(2) = chemin & "CNNMCO.JPG"
nomLogo(3) = chemin & "Damen.JPG"
nomLogo(4) = chemin & "DCNS.JPG"
nomLogo(5) = chemin & "Dehimi.gif"
nomLogo(6) = chemin & "eads.JPG"
nomLogo(7) = chemin & "Eiffel.JPG"
nomLogo(8) = chemin & "IDP.gif"
nomLogo(9) = chemin & "IUT.jpg"
nomLogo(10) = chemin & "métalform.JPG"
nomLogo(11) = chemin & "Navtis.JPEG"
nomLogo(12) = chemin & "Oxymax.JPG"
nomLogo(13) = chemin & "Piriou.JPG"
nomLogo(14) = chemin & "Sneff.JPG"
nomLogo(15) = chemin & "Sobe.JPG"
nomLogo(16) = chemin & "sofresid.JPG"

nomSociete(1) = "Alpha métal"
nomSociete(2) = "CNN MCO"
nomSociete(3) = "Damen"
nomSociete(4) = "DCNS"
nomSociete(5) = "Dehimi"
nomSociete(6) = "EADS"
nomSociete(7) = "Eiffel"
nomSociete(8) = "IDP"
nomSociete(9) = "IUT"
nomSociete(10) = "Métalform"
nomSociete(11) = "Navtis"
nomSociete(12) = "Oxymax"
nomSociete(13) = "Piriou"
nomSociete(14) = "Snef"
nomSociete(15) = "Sobec"
nomSociete(16) = "Sofresid"

 Dim Shp As Shape
For i = 1 To 16
    If societe.Value = nomSociete(i) Then
      Image1.Picture = LoadPicture(nomLogo(i))

    '######################################
   'POUR L'INSERER DANS LA FEUIL1
   '######################################
       'Définit l'emplacement de l'image
       Set Emplacement = Range("A1:B3")
        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
        With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
           .Name = "Cible"
        End With
        ActiveSheet.Shapes("Cible").Delete
        Set Shp = Feuil2.Shapes.AddPicture(nomLogo(i), msoFalse, msoCTrue, 100, 0, 70, 50)

    End If
Next i

 End Sub

si répertoire IMG\entreprises se trouve dans le répertoire par défaut de l'utilisateur, remplace le bout de code

Dim nomSociete(1 To 16) As String
chemin = ThisWorkbook.Path
If chemin <> "" Then chemin = chemin & "\"

nomLogo(1) = chemin & "Alpha métal"

par ceci.

Dim nomSociete(1 To 16) As String
chemin = Environ("homepath")
If chemin <> "" Then chemin = chemin & "\"
chemin = chemin & "IMG\Entreprises\"
nomLogo(1) = chemin & "Alpha métal"

COOL !!!!!

Merci beaucoup

Tous fonctionne !

Rechercher des sujets similaires à "chargement image"