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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

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...
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour