Question

我正在尝试将图像插入到Excel工作表中。

代码很简单：

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

但这不起作用。当我在file上设置手表时，我可以看到它包含我硬盘上图像的有效路径。

使用图像填充单元格需要做什么？

Answer 1

你不能将图片“放入”一个单元格中，只能“覆盖”它。所有图片都“浮动”在工作表上。您可以通过将单元格的顶部和左侧属性设置为单元格的顶部和左侧来将图片放置在单元格上。

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

然后你会这样称呼：

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

注意： 这会将图像定位并调整大小，使其在工作表上的大小和位置与调用子时指定的单元格相同。这会将图片插入您想要图片的单元格区域。这也可能是一系列单元格，如B5:G25或在我的示例中为单个单元格，如Range("A1")，图片将覆盖所有范围内的细胞。

Answer 2

是的，您可以将图片添加到单元格中，至少它适用于我：

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

Answer 3

您需要 Sub 而不是功能。

修改＃1 ：

确保您的路径和文件名正确无误。这是一个适合我的例子：

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

如何使用图像填充Excel单元格？

3 个答案: