XL 2010 Coller image par l'intermédiaire d'une InputBox

Francky79

XLDnaute Occasionnel
Bonsoir le forum;

Vraiment novice en VBA et Excel je récupère des bouts de codes a droite a gauche et je me bricol mes petites applications.
Mais la je coince.
Dans une macro, ouvrir l'explorateur Windows choisir une image, sélectionner une cellule avec l'inputBox,et la ça cloche, copier l'mage dans cette sélection.
Comment coller l'image a la ôsition de l'inputBox.

Merci pour votre aide.
 

Pièces jointes

  • Test Image.xlsm
    22.6 KB · Affichages: 18
Solution
Bonjour,

A la place de "ActiveCell", il faut mettre "Position"

VB:
Private Sub CommandButton2_Click()
    Dim ficimg As Variant
    ChDir "C:\Users\Franck\Documents\Excel" 'Indiquer le chemin complet jusqu'au répertoir voulu
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")  ' choix nom du fichier
    Set Position = Application.InputBox("Sélectionne la cellule où copier les données !", "Sélection de cellules", Type:=8)
    ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
    With Selection.ShapeRange
        .LockAspectRatio = False        ' proportion d'origine lorsque vous la redimensionnez
        .Top = Position.Top           ' haut de la cellule
        .Left = Position.Left         ' gauche de...

Rouge

XLDnaute Impliqué
Bonjour,

A la place de "ActiveCell", il faut mettre "Position"

VB:
Private Sub CommandButton2_Click()
    Dim ficimg As Variant
    ChDir "C:\Users\Franck\Documents\Excel" 'Indiquer le chemin complet jusqu'au répertoir voulu
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")  ' choix nom du fichier
    Set Position = Application.InputBox("Sélectionne la cellule où copier les données !", "Sélection de cellules", Type:=8)
    ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
    With Selection.ShapeRange
        .LockAspectRatio = False        ' proportion d'origine lorsque vous la redimensionnez
        .Top = Position.Top           ' haut de la cellule
        .Left = Position.Left         ' gauche de la cellule
        .Height = Position.RowHeight  ' hauteur de la cellule
        .Width = Position.Width ' largeur de la cellule
    End With
    With Selection
        .PrintObject = True             ' l'objet est imprimé en même temps que le document
        .Placement = xlMoveAndSize      ' manière dont l'objet est lié aux cellules
    End With
End Sub

Cdlt
 

Discussions similaires