Discussion :

[retraite83]

Bonjour,

je cherche une astuce pour contrôler qu'une image insérée dans une cellule ne déborde pas de la taille de la cellule.

Il s'agit d'un logo inséré par l'utilisateur avec une taille maximum équivalente à la taille de la cellule. Je ne peux pas redimensionner l'image car si elle est plus petite elle doit le rester

De plus je ne sais pas à priori si c'est la longueur ou la hauteur qui est hors norme.

J'envisage de récupérer la taille de l'image (ça doit être possible) et comparer ensuite les hauteurs et longueurs pour informer l'utilisateur que son logo est trop grand

Il y a peut être une solution plus simple ?

[retraite83]

Voilà le code que j'ai pu écrire pour ceux que cela intéresse pour obtenir la largeur et la hauteur d'une image située en "E13" sachant qu'il n'y a qu'une image dans la feuille "Logo"

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
Sub sizeImg()
 
Dim sh As Shape, log As Worksheet, Himage As Single, Limage As Single, photo As String
 
Set log = Sheets("Logo")
For Each sh In log.Shapes
    photo = "$E$13"
    If sh.Type = msoPicture Then
        If sh.TopLeftCell.Address = photo Then
            With Selection
                Himage = .Height
                Limage = .Width
            End With
            Exit Sub
        Else
        End If
    Else
    End If
Next
 
End Sub

Si on peut optimiser dites le moi

J'ai une incertitude sur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 With Selection

je ne suis pas certain que la sélection marche dans tous les cas de figure, on doit pouvoir assurer en faisant pointer la sélection sur l'image mieux que cela

[Philippe Tulliez]

Bonjour,
Voici une fonction générique que j'utilise régulièrement et qui en fonction des arguments passés à celle-ci charge l'image sur le disque et l'insère dans une cellule en redimensionnant l'image. J'ai mis en tête de procédure le lien du code dont je me suis très, très fort inspiré

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
Sub InsertPictureInCell(PictureFullName As String, TargetCell As Range)
  ' Arguments
  '   PictureFullName  Nom complet (répertoire + Nom de l'image
  '   TargetCell       Cellule où doit être placée l'image
  '
  Dim oPict As Picture
  Dim t As Single, l As Single, w As Single, h As Single
  Set oPict = Cell.Worksheet.Pictures.Insert(PictureFullName)
  '
  With Cell: t = .Top: l = .Left: w = .Width: h = .Height: End With
  '
  With oPict
  .Width = w
   If .Height > h Then
     .Height = h: .Left = l + (w - .Width) / 2: .Top = t
    Else
     .Left = l: .Top = t + (h - .Height) / 2
   End If
  End With
  Set oPict = Nothing
End Sub

Exemple d'une procédure qui l'invoque

CellName est le nom de la cellule cible

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub TestInsertPictureInCell_()
  Const Fullname As String = "C:\Users\Toto\appMeal\Picture\Vol au vent.jpg"
  Const CellName As String = "areaPicture"
  InsertPictureInCell Fullname, Range(CellName)
End Sub