0

我正在尝试将图像插入到 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我可以看到它包含指向我硬盘驱动器上图像的有效路径。

我需要做什么才能用图像填充单元格？

4

3 回答 3

3

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

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")

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

于 2013-10-18T13:38:45.553 回答
1

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

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
于 2015-03-27T15:16:14.147 回答
0

你需要一个Sub而不是一个Function。

编辑#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
于 2013-10-18T13:18:06.040 回答