VBA - Ajouter image (Chemin accès)

Version imprimable

Bonjour,

J'aurais besoin de vos lumières pour cette macro qui sert à insérer une image. La case H1 est automatiquement définie a partir d'une série de valeur. Bref, le classeur cherche lui même le chemin d'accès.

Le problème se situe probablement ici :
Chemin1 = Sheets("Prog").Range("H1").Value ' Valeur de H1 : U:\Badges\Photo\Aguis Ibtissem - Photo.jpg
ActiveSheet.Pictures.Insert(Chemin1).Select
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub Images() 'Sert à insérer 1 image Dim Chemin1$, Chemin1 = Sheets("Prog").Range("H1").Value ' Valeur de H1 : U:\Badges\Photo\Aguis Ibtissem - Photo.jpg Sheets("Gabari recto").Select ' Sert a insérer l'image 1 Range("C7:C11").Select ActiveSheet.Pictures.Insert(Chemin1).Select Selection.ShapeRange.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft End Sub
Merci de votre aide!

Bonjour,

Une solution un peu différente de la vôtre, nécessitant la référence Microsoft Windows Image Acquisition Library :

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
Option Explicit
 
Sub TesterLInsertImage2()
 
Dim RepertoireImage As String
Dim NomDeLImage As String
Dim ImageLargeur As Single
Dim ShImage As Worksheet
 
    With Sheets("Prog")
         RepertoireImage = .Range("H1")     ' Ne contient que le nom du répertoire
         NomDeLImage = .Range("I1")         ' Je dissocie le nom de l'image du chemin complet
    End With
 
    Set ShImage = Sheets("Gabari recto")
    With ShImage
         ImageLargeur = .Range("C7").Width  ' Pour fixer la largeur de l'image à la largeur de la colonne C
         ' ImageRatio est une fonction calculant la proportion Largeur / Hauteur pour respecter le format Paysage ou Portrait
         Insert_Image2 ShImage, ShImage.Range("C7"), RepertoireImage, NomDeLImage, ImageLargeur, ImageRatio(RepertoireImage & "\" & NomDeLImage)
    End With
    Set ShImage = Nothing
 
End Sub
 
Sub Insert_Image2(ByVal FeuilleImage As Worksheet, ByVal CelluleImage As Range, ByVal RepertoireImages As String, ByVal NomDuFichierImage As String, ByVal LargeurImage As Single, ByVal RatioImage As Single)
 
Dim MonImage As Shape
 
    With FeuilleImage
 
         ' Suppression de l'image existante
         '---------------------------------
         For Each MonImage In .Shapes
             If MonImage.Name = "ImageFeuille" Then MonImage.Delete
         Next MonImage
 
         ' Insertion de l'image
         '---------------------
         Set MonImage = .Shapes.AddShape(msoShapeRectangle, CelluleImage.Left, CelluleImage.Top, LargeurImage, LargeurImage / RatioImage)
         With MonImage
              .Name = "ImageFeuille"
              With .Fill
                   .Visible = msoTrue
                   .UserPicture RepertoireImages & "\" & NomDuFichierImage
              End With
              With .Line
                   .Visible = msoTrue
                   .Weight = 1
              End With
         End With
         Set MonImage = Nothing
 
    End With
 
 End Sub
 
Function ImageRatio(ByVal CheminEtNomDeLImage As String) As Single
 
' A partir du tuto "Utiliser la librairie Windows Image Acquisition en VBA" de SilkyRoad et Bbil
 
Dim Img As WIA.ImageFile
 
    Set Img = CreateObject("WIA.ImageFile")
    With Img
         .LoadFile CheminEtNomDeLImage
         ImageRatio = .Width / .Height
    End With
    Set Img = Nothing
 
End Function

La fonction ImageRatio récupère la proportion largeur / hauteur de l'image importée. La largeur de l'image est fixée par la largeur de la colonne C. La procédure TesterLInsertImage2 fixe les paramètres, vous pouvez donc importer vos images sur d'autres onglets.

Cordialement.

06/04/2016, 06h35
kiki29

Salut, toujours d'actualité : Utiliser la librairie Windows Image Acquisition en VBA
06/04/2016, 08h12
cerede2000
@Eric KERGRESSE : Pour info Eric, tu peux te passer de la référence si tu fait directement :
Code:

1 2 Dim Img As Object Set Img = CreateObject("WIA.ImageFile")
06/04/2016, 08h14
Invité

Citation:

Envoyé par cerede2000

@Eric KERGRESSE : Pour info Eric, tu peux te passer de la référence si tu fait directement :

Bonjour Cerede2000,

Effectivement.

Cordialement.
07/04/2016, 02h40
RH.applications

Bonjour,

Merci pour la réponse. Cela dit je ne comprend pas une bonne partie du code... Quel section dois-je supprimer et remplacer pour me passer de la fonction référence?

Il n'y aurait pas juste un moyen que le chemin d'accès se règle à partir de ActiveSheet.Pictures.Insert("").Select. Le code fonctionne quand on lui mette un chemin d'accès précis. Sachant que je doit le faire 8 fois, car j'insère 8 photos au même moment j'ai un peu peur que ce prenne 2 minutes à produire avec le code fourni... Déjà que là c'est un peu long...

Merci!
07/04/2016, 03h18
Invité

Citation:

Envoyé par RH.applications

Sachant que je doit le faire 8 fois, car j'insère 8 photos au même moment j'ai un peu peur que ce prenne 2 minutes à produire avec le code fourni...

Bonjour,

A quel endroit sont placées les 7 autres photos ?
Comment faites-vous pour les récupérer ? Choisissez vous les photos l'une après l'autre ou choisissez-vous les 8 photos d'un coup ? Sont-elles dans le même répertoire ?

Cordialement.
07/04/2016, 04h02
Invité

J'oubliais....

Le code fourni est le contenu d'un module complet. Il vous suffit de le copier-coller dans un nouveau module de votre fichier. De renommer le cas échéant TesterLInsertImage2 par le nom de votre macro Images() et de renommer votre ancienne procédure ImagesOld par exemple. Est-ce à votre portée ?

Testez le au moins une fois pour voir.

Nb : En ajoutant une boucle dans la procédure TesterLInsertImage2, vous pourriez récupérer vos 8 photos d'un coup sans que cela prenne beaucoup plus de temps.

Cordialement.
12/04/2016, 02h39
RH.applications

1 pièce(s) jointe(s)

Bonjour Éric,

Navré, je n'ai pas été en mesure d'adapter votre code.

Le classeur est fait pour être mis dans un dossier et trouver tous les fichiers qui sont avec lui dans ce même dossier (Voir macro). Il génère donc les chemin d'accès et les noms automatiquement. Dans mon fichier initial, j'ai des sécurité pour n'obtenir que le nom des images.

Bref, voici une version du fichier. J'ai fait un exemple avec 8 images pour mieux comprendre.

J'aimerais seulement comprendre comment mettre une image avec votre code l'aide des chemin d'accès du fichier. Mon ancienne macro d'insertion se trouve dans le module 1.

Cordialement,
12/04/2016, 07h29
Invité

Citation:

Envoyé par RH.applications

Bonjour,

Un fichier revisité.... Pièce jointe 206660

Dans cette version, le bouton Sélectionner les photos ouvre une boite de dialogue et remplit l'onglet avec le nom des fichiers pour les extensions .jpg et .png (liste à modifier dans la boite de dialogue). Le répertoire est noté également. L'import se fait depuis la boite de dialogue : cela signifie qu'on peut charger des images de répertoires différents sans effacer les photos déjà répertoriées.

Il ne reste plus qu'à définir la position des images sur l'onglet de destination.

Pièce jointe 206661

Conseil pour vous : Les macros doivent être placées de préférence dans des modules standards.
Dans cette version, les vedettes ont fait un gros ravalement de façade....:mouarf3:

Cordialement.

1 pièce(s) jointe(s)

Bonjour le forum,
J'ai repris le code du post 2 même si çà date un peu.
Il affiche l'image test mais me bug sur cette ligne que je comprends pas.

Code:

Set MonImage = .Shapes.AddShape(msoShapeRectangle, CelluleImage.Left, CelluleImage.Top, LargeurImage, LargeurImage / RatioImage)

Il s'agit d'insérer les 2 images qui sont sur la page acceuil qui ne s'affichent pas.
Voilà tout le code utilisé:

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
 Private Sub Workbook_Open()
   'Insertion photo mosaique
    Dim RepertoireImage As String, NomDeLImage As String, ImageLargeur As Single, ShImage As Worksheet
    With Sheets("Acceuil")
         RepertoireImage = "Photos"     ' Ne contient que le nom du répertoire
         NomDeLImage = "mosaique repar GP"         ' Je dissocie le nom de l'image du chemin complet
    End With
    Set ShImage = Sheets("Acceuil")
    With ShImage
         ImageLargeur = .Range("F3:S27").Width  ' Pour fixer la largeur de l'image à la largeur de la colonne C
         ' ImageRatio est une fonction calculant la proportion Largeur / Hauteur pour respecter le format Paysage ou Portrait
         Insert_Image2 ShImage, ShImage.Range("F3:S27"), RepertoireImage, NomDeLImage, ImageLargeur, ImageRatio(RepertoireImage & "\" & NomDeLImage)
    End With
    Set ShImage = Nothing
End Sub
 
Sub Insert_Image2(ByVal FeuilleImage As Worksheet, ByVal CelluleImage As Range, ByVal RepertoireImages As String, ByVal NomDuFichierImage As String, ByVal LargeurImage As Single, ByVal RatioImage As Single)
'macro complémentaire pour insérer les images
    Dim MonImage As Shape
    With FeuilleImage
         ' Suppression de l'image existante
         '---------------------------------
     '    For Each MonImage In .Shapes
      '       If MonImage.name = "ImageFeuille" Then MonImage.Delete
       '  Next MonImage
         ' Insertion de l'image
         '---------------------
         Set MonImage = .Shapes.AddShape(msoShapeRectangle, CelluleImage.Left, CelluleImage.Top, LargeurImage, LargeurImage / RatioImage)
         With MonImage
              .name = "mosaique repar GP"
              With .Fill
                   .Visible = msoTrue
                   .UserPicture "E:\Users\FRANCK\Documents\EXCEL\JOB\réparations\photos\" & "mosaique repar GP.jpg"
              End With
              With .Line
                   .Visible = msoTrue
                   .Weight = 1
              End With
         End With
         Set MonImage = Nothing
    End With
 End Sub
 
Function ImageRatio(ByVal CheminEtNomDeLImage As String) As Single
'macro complémentaire pour insérer les images
' A partir du tuto "Utiliser la librairie Windows Image Acquisition en VBA" de SilkyRoad et Bbil
Dim Img As Object
    Set Img = CreateObject("WIA.ImageFile")
    With Img
         .LoadFile "E:\Users\FRANCK\Documents\EXCEL\JOB\réparations\photos\" & "mosaique repar GP.jpg"
         ImageRatio = .Width / .Height
    End With
    Set Img = Nothing
End Function

Merci pour votre aide. :roll:
Pièce jointe 650010

01/02/2024, 10h09
frunch

Merci d'avoir changer de forum.
C'est vrai que j'aurai du faire une demande directe et mettre le fil en lien, çà aurait eut plus de vues. :oops: