How can I populate an Excel cell with an image?

后端 未结 3 1729
再見小時候
再見小時候 2021-01-17 02:34

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 Str         


        
相关标签:
3条回答
  • 2021-01-17 02:48

    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.

    0 讨论(0)
  • 2021-01-17 02:48

    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
    
    0 讨论(0)
  • 2021-01-17 02:52

    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
    
    0 讨论(0)
提交回复
热议问题