web-dev-qa-db-fra.com

Comment insérer une image dans Excel à une position de cellule spécifiée avec VBA

J'ajoute des fichiers ".jpg" à ma feuille Excel avec le code ci-dessous:

'Add picture to Excel
xlApp.Cells(i, 20).Select
xlApp.ActiveSheet.Pictures.Insert(picPath).Select
'Calgulate new picture size
With xlApp.Selection.ShapeRange
    .LockAspectRatio = msoTrue
    .Width = 75
    .Height = 100
End With
'Resize and make printable
With xlApp.Selection
    .Placement = 1 'xlMoveAndSize
    '.Placement = 2 'xlMove
    '.Placement = 3 'xlFreeFloating
    .PrintObject = True
End With

Je ne sais pas ce que je fais mal mais elle n'est pas insérée dans la bonne cellule. Que dois-je faire pour placer cette image dans une cellule spécifiée dans Excel?

23
Berker Yüceer

Essaye ça:

With xlApp.ActiveSheet.Pictures.Insert(PicPath)
    With .ShapeRange
        .LockAspectRatio = msoTrue
        .Width = 75
        .Height = 100
    End With
    .Left = xlApp.ActiveSheet.Cells(i, 20).Left
    .Top = xlApp.ActiveSheet.Cells(i, 20).Top
    .Placement = 1
    .PrintObject = True
End With

Il vaut mieux ne rien sélectionner dans Excel, cela n’est généralement jamais nécessaire et ralentit votre code.

41
SWa

S'il s'agit simplement d'insérer et de redimensionner une image, essayez le code ci-dessous.

Pour la question spécifique que vous avez posée, la propriété TopLeftCell renvoie l'objet de plage associé à la cellule où le coin supérieur gauche est parqué. Pour placer une nouvelle image à un endroit spécifique, je vous recommande de créer une image à la "droite" et d'enregistrer ses valeurs de propriétés supérieure et gauche du mannequin sur des variables doubles.

Insérez votre image assignée à une variable pour changer facilement son nom. L'objet Shape aura le même nom que l'objet Picture.

Sub Insert_Pic_From_File(PicPath as string, wsDestination as worksheet)
    Dim Pic As Picture, Shp as Shape
    Set Pic = wsDestination.Pictures.Insert(FilePath)
    Pic.Name = "myPicture"
    'Strongly recommend using a FileSystemObject.FileExists method to check if the path is good before executing the previous command
    Set Shp = wsDestination.Shapes("myPicture")
    With Shp
        .Height = 100
        .Width = 75
        .LockAspectRatio = msoTrue  'Put this later so that changing height doesn't change width and vice-versa)
        .Placement = 1
        .Top = 100
        .Left = 100
    End with
End Sub

Bonne chance!

1
FCastro

Je travaillais sur un système fonctionnant sur un PC et un Mac et je cherchais un code permettant d'insérer des images sur PC et Mac. Cela a fonctionné pour moi alors j'espère que quelqu'un d'autre pourra s'en servir!

Remarque: les variables strPictureFilePath et strPictureFileName doivent être définies sur des chemins PC et Mac valides, par exemple. 

Pour PC: strPictureFilePath = "E:\Dropbox \" et strPictureFileName = "TestImage.jpg" et avec Mac: strPictureFilePath = "Macintosh HD: Dropbox:" et strPictureFileName = "TestImage.jpg"

Code suivant:

    On Error GoTo ErrorOccured

    shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Select

    ActiveSheet.Pictures.Insert(Trim(strPictureFilePath & strPictureFileName)).Select

    Selection.ShapeRange.Left = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Left
    Selection.ShapeRange.Top = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Top + 10
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 130
1
Tristan