Bonjour,

Debutant en VBA, je cherche à insérer des images automatiquement (en colonne A) à partir d'un texte (colonne B).
Les images ont le meme nom que le texte en colonne B.

Le code ci-dessous permet d'insérer les images sans problème lorsque les cellules ne sont pas fusionnées :

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
 
Sub InsertPicsr1()
Dim fPath As String, fName As String
Dim r As Range, rng As Range
Dim shpPic As Shape
 
Application.ScreenUpdating = False
fPath = 'Insérer le nom du fichier où sont contenues les images
Set rng = Range("B2:B" & Cells(Rows.Count, 4).End(xlUp).Row)
For Each r In rng
    On Error GoTo errHandler
    If r.Value <> "" Then
        Set shpPic = ActiveSheet.Shapes.AddPicture(Filename:=fPath & r.Value & ".jpg", linktofile:=msoFalse, _
            savewithdocument:=msoTrue, Left:=Cells(r.Row, 1).Left, Top:=Cells(r.Row, 2).Top, Width:=-1, Height:=-1)
        With shpPic
            .LockAspectRatio = msoTrue
            If .Width > Columns(2).Width Then .Width = Columns(2).Width
            Rows(r.Row).RowHeight = .Height
        End With
    End If
errHandler:
If Err.Number <> 0 Then
    Debug.Print Err.Number & ", " & Err.Description & ", " & r.Value
    On Error GoTo -1
End If
Next r
Application.ScreenUpdating = True
End Sub
Toutefois, mes cellules étant fusionnées verticalement, la dimension de l'image insérée n'est pas adaptée à la cellule fusionnée de destination.

Savez-vous s'il serait possible d'adapter le code pour que chaque image chargée par la macro prenne automatiquement la dimension de la cellule fusionnée en conservant son "ratio"?
A titre informatif, chacune de mes celulles fusionnées auront la meme dimension, à savoir : A2:A7; A8:A13; ...

Merci par avance pour votre précieuse aide

++