Insertion automatique d'une image du Presse Papier

Bonjour,

Je cherche a créer un code VBA afin d'insérer une image automatiquement "copié dans le presse papier" dans une cellule précise.

Le TOP serait quelle soit redimensionner toute à l'identique.

Pouvez vous m'aider s'il vous plait

Je vous remercie

Hello,

votre profil indique "2013 fr" si c'est toujours le cas il n'est pas possible dans cette version d'insérer une image DANS une cellule. SUR une cellule (et même plusieurs selon la taille), oui.

ActiveSheet.Paste

ça ça suffit

ou

Range("D4").Parent.Paste

Ensuite vous dites "Le TOP serait quelle soit redimensionner toute à l'identique." là ça sous entend qu'il y a N image collées, il faudrait que vous indiquiez où elles sont collées et du coup il faudrait toutes les garder en mémoire

Bonjour,

La copie se fait dans la cellule sélectionnée :

Sub test()
  Dim Img As Shape, RImg As Double, RCel As Double
  With ActiveSheet
    .Paste
    Set Img = .Shapes(.Shapes.Count)
    RImg = Img.Width / Img.Height
    RCel = ActiveCell.Width / ActiveCell.Height
    If RImg > RCel Then
      Img.Width = ActiveCell.Width
    Else
      Img.Height = ActiveCell.Height
    End If
  End With
End Sub

Daniel

Bonjour,

@ DanielC : j'ai essayé votre code mais l'image se met en A1 si elle est copiée à partir de Paint.

Ce code généré par une IA fonctionne ;

Sub ImaPressPap()
    Dim img As Shape
    Dim oldCount As Long

    ' Compter les images existantes pour identifier la nouvelle
    oldCount = ActiveSheet.Shapes.Count

    On Error Resume Next
    ' On colle sans argument Destination (plus fiable avec Paint)
    ActiveSheet.Paste

    ' Si une nouvelle image a été ajoutée
    If ActiveSheet.Shapes.Count > oldCount Then
        ' La dernière image ajoutée est la nouvelle
        Set img = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

        ' On force le déplacement vers la cellule active
        With img
            .Top = ActiveCell.Top
            .Left = ActiveCell.Left
            ' Optionnel : nommer l'image
            '.Name = "Capture_" & Format(Now, "hhmmss")
        End With
    Else
        If Err.Number <> 0 Then
            MsgBox "Presse-papier vide ou format non supporté.", vbInformation
            Err.Clear
        End If
    End If
    On Error GoTo 0
End Sub

Ecoute, tant mieux pour toi.

Daniel

Merci pour votre aide, cela fonctionne.