How can I populate an Excel cell with an image?

问题

I'm trying to insert an image into an excel worksheet.

The code is simply:

Function AddImage(path As String, filename As String)
    Dim file As String
    file = path + "/" + filename + ".png"

    ActiveSheet.Range("A1").Pictures.insert(file).Select
End Function

but this doesn't work. When I set a watch on file I can see that it contains a valid path to an image on my hard drive.

What do I need to do to populate a cell with an image?

回答1:

You cannot put pictures "in" a cell, only "over" it. All pictures "float" on the worksheet. You can position a picture over a cell by setting its Top and Left properties to the Top and Left of the cell.

Sub AddPicOverCell(path As String, filename As String, rngRangeForPicture As Range)
With Application
Dim StartingScreenUpdateing As Boolean
Dim StartingEnabledEvent As Boolean
Dim StartingCalculations As XlCalculation

StartingScreenUpdateing = .ScreenUpdating
StartingEnabledEvent = .EnableEvents
StartingCalculations = .Calculation

    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Dim Top As Single, Left As Single, Height As Single, Width As Single
Dim file As String
Dim ws As Worksheet

file = path + "/" + filename + ".png"

Top = rngRangeForPicture.Top
Left = rngRangeForPicture.Left
Height = rngRangeForPicture.Height
Width = rngRangeForPicture.Width

Set ws = rngRangeForPicture.Worksheet

ws.Shapes.AddPicture file, msoCTrue, msoTrue, Left, Top, Width, Height

With Application
    .ScreenUpdating = StartingScreenUpdateing
    .EnableEvents = StartingEnabledEvent
    .Calculation = StartingCalculations
End With
End Sub

And then you would call it like:

AddPicOverCell "C:\", "Pic", ActiveSheet.Range("A1")

NOTES: This will position and resize the image to the same size and position on the sheet as the Cell you specify when calling the sub. This will insert the picture over the cell OR range you want the picture in. This could also be a range of cells like B5:G25 or as in my example a single cell like Range("A1") and the picture will cover all cells in the range.

回答2:

yes, you can add a picture to a cell, at least it works for me:

Sub testInsertAndDeletePicInCell()

Dim rng_PicCell         As Range
Dim thisPic             As Picture

Const MaxH = 50
Const MaxW = 14


    ' INSERT a picture into a cell

    ' assign cell to range
    Set rng_PicCell = ActiveSheet.Cells(2, 2) ' cell B2

    ' modify the range
    With rng_PicCell
        .RowHeight = MaxH
        .ColumnWidth = MaxW

        ' insert the picture
        Set thisPic = .Parent.Pictures.Insert("C:\tmp\mypic.jpg")

        ' format so the picture fits the cell frame
        thisPic.Top = .Top + 1
        thisPic.Left = .Left + 1
        thisPic.Width = .Width - 2
        thisPic.Height = .Height - 2

    End With


    Stop

    ' DELETE a picture
    thisPic.Parent.Pictures.Delete

End Sub

回答3:

You need a Sub rather than a Function.

EDIT#1:

Make sure your path and filename are correct. Here is an example that works for me:

Sub qwerty()
    Dim p As Picture
    Dim sPath As String, sFileName As String, s As String
    sPath = "F:\Pics\Wallpapers\"
    sFileName = "mercury.jpg"
    s = sPath & sFileName
    Set p = ActiveSheet.Pictures.Insert(s)
End Sub

来源：https://stackoverflow.com/questions/19448727/how-can-i-populate-an-excel-cell-with-an-image

标签

excel

vba

excel-vba