Discussion :

[RH.applications]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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!

[Invité]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[kiki29]

Salut, toujours d'actualité : Utiliser la librairie Windows Image Acquisition en VBA

[cerede2000]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim Img As Object
Set Img = CreateObject("WIA.ImageFile")

[Invité]

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

Bonjour Cerede2000,

Effectivement.

Cordialement.

[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!