Inserer image a partir d'un bouton et la redimensionner

[william69]

Bonjour,

tout d'abord, bravo pour ce forum très complet qui m'a beaucoup aidé à me lancer dans la prog en vba.

Mais me voici bloqué sur une macro qui doit être simple, mais bon, la voici:

Je cherche à permettre à l'utilisateur d'inserer une photo selectionnée dans un dossier en cliquant sur un bouton placé dans un userform. La photo n'est jamais la même d'un utilisateur à l'autre, il peut mettre celle qu'il veut. Jusque là, pas de problème, je passe par la boïte de dialogue "inserer une image" d'excel.
Cette photo est ensuite placée sur une cellule bien précise de la feuille. Là aussi, je me suis débrouillé et la photo s'insere a l'endroit exact où je veux.

Seulement maintenant, j'aimerais aussi que la macro redimensionne la photo (jamais la même dimension d'une insertion à l'autre et surtout toujours trop grande...) aux dimensions de la cellule, juste après l'insertion. Et c'est là que ça coince, je n'ai trouvé aucun code qui semble à ma portée.

Voici ma macro, simpliste et minimaliste, comme je les aime:

Private Sub Inser_image_Click()
'insere et redimensionne image

Sheets("Feuil").Select 'selectionne la feuille
Range("E50").Select 'la cellule dans laquelle je veux inserer la photo
Application.Dialogs(xlDialogInsertPicture).Show 'ouvre la boite de dialogue excel -inserer image-
End Sub

Au juste, je ne sais pas comment dire :
"Selectionne l'image en E50 de la sheet "Feuil"
puis redimensionne cette image aux proportions de la cellule"
qui doit peut-être se traduire par:
Width = ActiveCell.Width
Height = ActiveCell.Height

Merci d'avance de votre réponse.

Cdlt,
Will

 

[bqtr]

Re : Inserer image a partir d'un bouton et la redimensionner

Bonjour,

Regarde ce fichier (qui n'est pas de moi) issu de ce forum, il contient une macro pour insérer et redimensionner une image dans une ou des cellules d'une feuille.

Tu affectes cette macro au bouton de ton USF.


A+

 

[Hulk]

Re : Inserer image a partir d'un bouton et la redimensionner

Hello,

Une autre version pas de moi non plus... Bravo à l'auteur !

Private Sub Inser_image_Click()

    'insere et redimensionne image
    
    Dim MaCellule As Range
    Dim s As Shape
    
    On Error Resume Next

    'Pour effacer les images au fur et à mesure
    For Each s In ActiveSheet.Shapes
        If s.Type = msoPicture Then s.Delete
    Next s
       
    Set MaCellule = Range("E50") 'la cellule dans laquelle je veux inserer la photo
    
    x = Application.Dialogs(xlDialogInsertPicture).Show 'ouvre la boite de dialogue excel -inserer image-
    ActiveSheet.Pictures.Insert(x & ".jpg").Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
  
    With Selection
        .Top = MaCellule.Top
        .Left = MaCellule.Left
        .Height = MaCellule.Height
        .Width = MaCellule.Width
    End With

End Sub

Cdt Hulk.

 

[william69]

Re : Inserer image a partir d'un bouton et la redimensionner

Merci pour vos réponses,
celle de Hulk est la plus efficace et la plus simple, même si celle de bqtr fonctionne aussi très bien.

Seulement, la macro s'execute sur la feuille à partir de laquelle je lance l'USF, alors que je l'emplacement de mon image est situé sur une autre feuille.
J'ai essayé de remplacer ActiveSheet par WorkSheets("la feuil que je veux"), mais rien n'y fait. J'ai essayé de bricoler d'autres choses glanées par ci par là, mais toujours pareil.

Que dois-je modifier dans la macro de hulk pour y parvenir ?

Cdlt,
Will

 

[william69]

Re : Inserer image a partir d'un bouton et la redimensionner [RESOLU]

J'ai finalement trouvé comment faire fonctionner cette macro sur une autre feuille que celle d'où je démarre l'USF. En rouge mes modifs apportées au code de Hulk.

Merci à vous.

Private Sub Inser_image_Click()
'insere et redimensionne image

Dim MaCellule As Range
Dim s As Shape
Sheets("Mafeuille").Select
On Error Resume Next

For Each s In Worksheets("Mafeuille").Shapes
If s.Type = msoPicture Then s.Delete
Next s

Set MaCellule = Range("Mafeuille!E50:H50") 'la cellule dans laquelle je veux inserer la photo

x = Application.Dialogs(xlDialogInsertPicture).Show 'ouvre la boite de dialogue excel -inserer image-
Worksheets("Mafeuille").Pictures.Insert(x & ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse

With Selection
.Top = MaCellule.Top
.Left = MaCellule.Left
.Height = MaCellule.Height
.Width = MaCellule.Width
End With

End Sub