Discussion :

[RaphPSG]

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

++

[patricktoulon]

bonjour
regarde du coté de tacellule .mergearea.width ou .height

[RaphPSG]

Bonjour Patrick,

Merci pour votre retour.
A vrai dire je n'ai aucune notion en VBA, je cherche des macros sur internet puis j'éssaye tant bien que mal de les adapter à mon fichier.

Pour le coup, j'ai déjà essayé de changer certaines lignes de la macro en question dans les mentions "width" et "height" mais sans success (les images ne chargent plus) ...

++