[Résolu] Insert photos externes centrées dans cellules fusionnées

[Polobe36]

bonjour le forum,

çà fait un petit moment que je cherche à adapter (sans succès = je suis une quiche en VBA) des codes que j'ai trouvé sur les forums et sur le site de boisgontierjacques.free.fr/pages_site/lesimages.htm#InsertionImage afin de pouvoir insérer dans une feuille ("E_SOP") plusieurs photos externes dans des cellules fusionnées.

Les adresses des photos se trouvent dans une feuille tierce ("R_SOP") et voici la méthodes que j'utilise:

Sub InsertPhoto_Page1()

Dim Photo_Page1 As String
Dim Largeur As Double

On Error Resume Next

Photo_Page1 = Sheets("R_SOP").Range("i3").Value
Worksheets("E_SOP").Range("av23:bp44").Select
Worksheets("E_SOP").Pictures.Insert(Photo_Page1).Select
Largeur = 631 / Selection.ShapeRange.Height
Selection.ShapeRange.ScaleHeight Largeur, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth Largeur, msoFalse

End Sub

Sub InsertPhoto_Page2()

Dim Photo_Page2 As String
Dim Largeur As Double

On Error Resume Next

Photo_Page2 = Sheets("R_SOP").Range("i4").Value
Worksheets("E_SOP").Range("av60:bp84").Select
Worksheets("E_SOP").Pictures.Insert(Photo_Page2).Select
Largeur = 631 / Selection.ShapeRange.Height
Selection.ShapeRange.ScaleHeight Largeur, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth Largeur, msoFalse

End Sub

Maintenant, je ne sais pas adapter cela pour que les images insérées soient centrées dans leurs cellule respective.

Merci par avance de votre aide

 

[phlaurent55]

Re : Insert photos externes centrées dans cellules fusionnées

Bonjour Polobe,

tu trouveras beaucoup d'exemples sur le site de Jacques Boisgontier en cliquant ci-dessous

Les images et shapes

à+
Philippe

 

[Polobe36]

Re : Insert photos externes centrées dans cellules fusionnées

bonjour phlaurent55,

merci de ton attention. j'avais effectivement essayé plusieurs exemple de Jacques Boisgontier et notamment celui ci:

répertoirePhoto = "c:\mesdoc\" ' Adapter
nom = "droc"
Set c = Range("B2").MergeArea
With ActiveSheet
.Pictures.Insert(répertoirePhosto & nom & ".jpg").Name = nom
.Shapes(nom).Left = c.Left
.Shapes(nom).Top = c.Top
.Shapes(nom).LockAspectRatio = msoFalse
.Shapes(nom).Height = c.Height
.Shapes(nom).Width = c.Width
End With

Mais j'avoue ne pas tout comprendre et surtout pourquoi le code prend en compte toute les shapes de ma feuille. Il y a surement quelque chose que je fais pas correctement mais je ne sais pas quoi.
Voilà pourquoi j'aurai besoin d'un p'tit coup de main

 

[Paf]

Re : Insert photos externes centrées dans cellules fusionnées

Bonjour à tous

avec un classeur exemple pour faire des tests, ce serait plus facile de répondre

a priori la position gauche de l'image= (largeur de la zone - largeur de l'image) /2; a voir comment ça réagit sur des cellules fusionnées.

A+

 

[phlaurent55]

Re : Insert photos externes centrées dans cellules fusionnées

Re-Bonjour à tous,

un petit fichier vite fait pour calculer les positions et dimensions d'une cellule fusionnée

à+
Philippe

 

[Polobe36]

Re : Insert photos externes centrées dans cellules fusionnées

Bonjour à tous,

sur vos conseils, voici un petit exemple avec ce que j'ai réussi à faire (voir macro insert, insert 2 et insert 3)
Il me faudra mettre les adresses de photos en variable, ce qui veut dire pour mon besoin de faire référence à des cellules d'une feuille tierce.

La solution me convient, peut-être avez-vous une autre idée, ou encore la possibilité d'optimiser le code

Sub insert()
Dim répertoirePhoto As String
Dim Nom As String
Dim c As Object

répertoirePhoto = "C:\Users\Public\Pictures\Sample Pictures\"
Nom = "Autumn Leaves"
Set c = Range("av23").MergeArea
With ActiveSheet
.Pictures.insert(répertoirePhoto & Nom & ".jpg").Name = Nom
.Shapes(Nom).Left = c.Left
.Shapes(Nom).Top = c.Top
.Shapes(Nom).LockAspectRatio = msoFalse
.Shapes(Nom).Height = c.Height
.Shapes(Nom).Width = c.Width
End With
End Sub
Sub insert2()
Dim répertoirePhoto2 As String
Dim Nom2 As String
Dim c As Object

répertoirePhoto2 = "C:\Users\Public\Pictures\Sample Pictures\"
Nom2 = "Creek"
Set c = Range("a41").MergeArea
With ActiveSheet
.Pictures.insert(répertoirePhoto2 & Nom2 & ".jpg").Name = Nom2
.Shapes(Nom2).Left = c.Left
.Shapes(Nom2).Top = c.Top
.Shapes(Nom2).LockAspectRatio = msoFalse
.Shapes(Nom2).Height = c.Height
.Shapes(Nom2).Width = c.Width
End With
End Sub
Sub insert3()
Dim répertoirePhoto3 As String
Dim Nom3 As String
Dim c As Object

répertoirePhoto3 = "C:\Users\Public\Pictures\Sample Pictures\"
Nom3 = "Desert Landscape"
Set c = Range("bj1").MergeArea
With ActiveSheet
.Pictures.insert(répertoirePhoto3 & Nom3 & ".jpg").Name = Nom3
.Shapes(Nom3).Left = c.Left
.Shapes(Nom3).Top = c.Top
.Shapes(Nom3).LockAspectRatio = msoFalse
.Shapes(Nom3).Height = c.Height
.Shapes(Nom3).Width = c.Width
End With
End Sub

Les cellules coloriées en jaune sont fusionnées et la cible des photos à insérer.
Bon dimanche ensolleillé à tous

 

[Polobe36]

Re : Insert photos externes centrées dans cellules fusionnées

Bonjour à tous, le forum,

Pour vous faire part de mon avancé, pensant que mon besoin est satisfait.

Sub InsertPhoto_Page1()

Dim Photo_Page1 As String
Dim c As Object

Photo_Page1 = Sheets("R_SOP").Range("i3").Value 'chemin d'accès de la shape
Set c = Range("av23").MergeArea

With ActiveSheet
.Pictures.insert(Photo_Page1).Name = Photo_Page1
.Shapes(Photo_Page1).Left = c.Left
.Shapes(Photo_Page1).Top = c.Top
.Shapes(Photo_Page1).LockAspectRatio = msoFalse
.Shapes(Photo_Page1).Height = c.Height
.Shapes(Photo_Page1).Width = c.Width
End With
With ActiveSheet.Shapes(Photo_Page1).Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Weight = 1.5
End With
End Sub

Merci de votre aide.
Bonne journée
Cordialement