Chargement image
O
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"
O
COOL !!!!!
Merci beaucoup
Tous fonctionne !