Insert image dans cellule

Bonjour,

le code suivant me permet d’insérer des photos dans des cellules excel.

Savez vous comment le modifier pour pouvoir le faire sur des cellules fusionnées ?

Public Sub insere_image()

Dim ficimg, nbImg As Byte

On Error Resume Next

ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image", , True) ' choix nom du fichier

For Each cel In Selection

cel.Activate

nbImg = nbImg + 1

If Not ficimg(nbImg) = "" Then

ActiveSheet.Pictures.Insert(ficimg(nbImg)).Select ' insertion

With Selection.ShapeRange

.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez

.Top = ActiveCell.Top ' haut de la cellule

.Left = ActiveCell.Left ' gauche de la cellule

.Height = ActiveCell.RowHeight ' hauteur de la cellule

.Width = ActiveCell.Width ' largeur de la cellule

End With

End If

Next

End Sub

Bonjour,

Peut-être...
remplacer :

cel.Activate

par :

cel.Cells(1).Activate

Bonjour,

non ça ne fonctionne pas

Bonjour,

En considérant que :

> Tu sélectionnes bien les bonnes cellules avant de lancer la macro,

> Tu as systématiquement des fusions de 7 lignes par 2 colonnes

Public Sub insere_image()
Dim ficimg, nbImg As Byte, cel As Range

    'On Error Resume Next
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image", , True) ' choix nom du fichier
    Set cel = Selection.Cells(1)
    For nbImg = 1 To UBound(ficimg)
        If Not ficimg(nbImg) = "" Then
            ActiveSheet.Pictures.Insert(ficimg(nbImg)).Select ' insertion
            With Selection.ShapeRange
                .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
                .Top = cel.Top ' haut de la cellule
                .Left = cel.Left ' gauche de la cellule
                .Height = cel.RowHeight * 7 ' hauteur de la cellule
                .Width = cel.Width * 2  ' largeur de la cellule
            End With
        End If
        Set cel = cel.Offset(1)
    Next
End Sub

Merci Franck.

l'ajustement est un peu moins précis que sur la macro d'origine mais ca va le faire.

merci pour ta réponse.

Bonjour,

Pour un ajustement plus précis, remplacer :

                .Height = cel.RowHeight * 7 ' hauteur de la cellule
                .Width = cel.Width * 2  ' largeur de la cellule

par :

                .Height = cel.RowHeight + cel.Offset(1, 0).RowHeight + cel.Offset(2, 0).RowHeight + cel.Offset(3, 0).RowHeight + cel.Offset(4, 0).RowHeight + cel.Offset(5, 0).RowHeight + cel.Offset(6, 0).RowHeight
                .Width = cel.Width + cel.Offset(0, 1).Width

BOnjour Franck,

c'est parfait merci.

Je t’embête une dernière fois si possible.

Ou est ce que je dois modifier le code pour la fusion d'1 colonne sur 8 lignes stp ?

Cordialement

Julien

Pour les lignes, tu dois calculer la hauteur, soit la ligne de code :

.Height = cel.RowHeight + cel.Offset(1, 0).RowHeight + cel.Offset(2, 0).RowHeight + cel.Offset(3, 0).RowHeight + cel.Offset(4, 0).RowHeight + cel.Offset(5, 0).RowHeight + cel.Offset(6, 0).RowHeight

dans le code ci-dessus, tu vois que l'on calcule la hauteur de 7 cellules :

cel, cel.Offset(1, 0), cel.Offset(1, 0), cel.Offset(1, 0),..., cel.Offset(6, 0)

Offset : créé un décalage de x lignes et x colonnes, Offset(lignes, colonnes)

Pour 8 lignes :

.Height = cel.RowHeight + cel.Offset(1, 0).RowHeight + cel.Offset(2, 0).RowHeight + cel.Offset(3, 0).RowHeight + cel.Offset(4, 0).RowHeight + cel.Offset(5, 0).RowHeight + cel.Offset(6, 0).RowHeight + cel.Offset(7, 0).RowHeight

----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Pour les colonnes, tu dois calculer la largeur, soit la ligne de code :

.Width = cel.Width + cel.Offset(0, 1).Width

dans le code ci-dessus, tu vois que l'on calcule la largeur de 2 cellules : cel et cel.Offset(0, 1)

Pour une seule :

.Width = cel.Width