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!

[Invité]

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.

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

[RH.applications]

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,

[Invité]

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....


Cordialement.

[frunch]

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 :

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

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 :

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
 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.
forum.xlsm

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