XL pour MAC Macro pour insérer une image Bonjour, Je viens vers vous car après plusieurs jours de recherche je

[dubarre]

Bonjour,

Je viens vers vous car après plusieurs jours de recherche je Cherche à trouver la solution je suis débutant veuillez m'en excuser je suis un artiste peintre et pour garder une trace de tous les tableaux que je réalise je crée une fiches d'identité dans laquelle je dois insérer la photo du tableau .

Ma question est comment dans le bouton je peux intégrer une macro oh je vais pouvoir aller chercher la photo concernée. Je suis vraiment désolé mais là je ne sais pas par où commencer je vous remercie cordialement

 

[job75]

Bonjour dubarre,

Téléchargez les fichiers joints et exécutez cette macro :

Sub InsererImage()
Dim fichier As Variant, s As Shape
fichier = Application.GetOpenFilename
If fichier = False Then Exit Sub
ActiveCell.Activate 'au cas où un objet serait sélectionné
For Each s In ActiveSheet.Shapes
    If Not Intersect(Selection, s.TopLeftCell) Is Nothing Then s.Delete
Next
ActiveSheet.Shapes.AddPicture fichier, True, True, Selection.Left, Selection.Top, Selection.Width, Selection.Height
End Sub

La boîte de dialogue permet de choisir le fichier Image1.jpg.

A+

 

[dubarre]

Bonjour ça fonctionne excellent je te remercie par contre seule petite chose comment faire pour que la photo garde sa dimension correct s'il te plaît

 

[job75]

Avec cette macro les proportions de l'image d'origine sont conservées :

Sub InsererImage()
Dim fichier As Variant, s As Shape, x, y, w, h
fichier = Application.GetOpenFilename
If fichier = False Then Exit Sub
ActiveCell.Activate 'au cas où un objet serait sélectionné
Application.ScreenUpdating = False
For Each s In ActiveSheet.Shapes
    If Not Intersect(Selection, s.TopLeftCell) Is Nothing Then s.Delete
Next
x = Selection.Left: y = Selection.Top: w = Selection.Width: h = Selection.Height
With ActiveSheet.Shapes.AddPicture(fichier, True, True, x, y, -1, -1)
    .LockAspectRatio = msoTrue 'conserve les proportions de l'image d'origine
    .Width = w
    If .Height < h Then
        .Top = y + (h - .Height) / 2
    Else
        .Height = h
        .Left = x + (w - .Width) / 2
    End If
End With
End Sub