Insérer photos: problème de positionnement et dimensionnement aleatoire

Bonjour,

J'ai une macro qui insère des photos dans des feuilles excel. Le but est de positionner une photo dans chacune des cellules en dimensionnant la photo a la hauteur de la cellule en respectant les proportions.

J'insère d'abord la photo en taille réelle puis je la redimensionne.

Le problème est que cela fonctionne sur certaines feuilles mais pas toutes.

Ci-dessous un exemple ou cela fonctionne bien:

Et la un autre ou l'on voit que les photos sont centrées sur la cellule et plus hautes:

Ci-dessous la partie de la macro correspondante:

    varSheetsCount = Sheets.Count
    For i = 4 To varSheetsCount
        Sheets(i).Activate
        varRowCount = Cells(Rows.Count, 1).End(xlUp).Row
        Rows("11:" & varRowCount).RowHeight = 400
        For i_line = 11 To varRowCount
            With ActiveSheet
                Cells(i_line, 1).Select
                varNameAndPath = Cells(i_line, 1)
                With Selection
                    posHeight = .Height
                    posLeft = .Left
                    posTop = .Top
                End With
                Dim shp As Shape
                Set shp = .Shapes.AddPicture(varNameAndPath, msoFalse, msoCTrue, ActiveCell.Left, ActiveCell.Top, -1, -1)
                With shp
                    .LockAspectRatio = True
                    .Height = 400
                    .Left = posLeft
                    .Top = posTop                    
                End With
            End With
        Next i_line
    Next i
 

Est-ce que je passe a cote de quelque chose?

Merci d'avance.

Gilles

bonjour Gilles_Iceman, Ce "LockaspectRatio" peut-être que vous le voulez false ?

Avec true, on ne peut pas adapter les 2 dimensions à la cellule, oubien l'un ou l'autre sera trop grand/trop petit.

    Dim c, shp
     i_line = 10
     With ActiveSheet
          Set c = Cells(i_line, 1)
          varNameAndPath = c.Value
          Set shp = .Shapes.AddPicture(varNameAndPath, msoFalse, msoCTrue, c.Left, c.Top, c.Offset(, 1).Left - c.Left, c.Offset(1).Top - c.Top)
          shp.LockAspectRatio = False        'True ou false ????
     End With

ou

  Dim c, shp
     i_line = 10
     With ActiveSheet
          Set c = Cells(i_line, 1)
          varNameAndPath = c.Value

          With .Shapes.AddPicture(varNameAndPath, msoFalse, msoCTrue, c.Left, c.Top, -1, -1)
               .LockAspectRatio = true      'ne pas déformer le photo et c'est "width" qui décide !!
               .Width = c.Offset(, 1).Left - c.Left
               '.Height = c.Offset(1).Top - c.Top

          End With
     End With

re,

ou comme ça ?

   Dim c, shp, dWidth, dHeight
     i_line = 10
     With ActiveSheet
          Set c = Cells(i_line, 1)
          varNameAndPath = c.Value

          With .Shapes.AddPicture(varNameAndPath, msoFalse, msoCTrue, c.Left, c.Top, -1, -1)
               dWidth = .Width / (c.Offset(, 1).Left - c.Left)
               dHeight = .Height / (c.Offset(1).Top - c.Top)

               .LockAspectRatio = True       'déformer le photo ???
               If dWidth >= dHeight Then
                    .Width = c.Offset(, 1).Left - c.Left
               Else
                    .Height = c.Offset(1).Top - c.Top
               End If
          End With
     End With