vba 如何用图像填充 Excel 单元格？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19448727/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How can I populate an Excel cell with an image?
提问by DaveDev
I'm trying to insert an image into an excel worksheet.
我正在尝试将图像插入到 Excel 工作表中。
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 fileI can see that it contains a valid path to an image on my hard drive.
但这不起作用。当我打开手表时，file我可以看到它包含到我硬盘驱动器上的图像的有效路径。
What do I need to do to populate a cell with an image?
我需要做什么才能用图像填充单元格？
回答by user2140261
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.
你不能把图片“放在”一个单元格中，只能“放在”它上面。所有图片“浮动”在工作表上。您可以通过将图片的 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
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:G25or as in my example a single cell like Range("A1")and the picture will cover all cells in the range.
注意：这会将图像定位和调整大小，使其与您在调用 sub 时指定的单元格在工作表上的大小和位置相同。这会将图片插入到您想要图片所在的单元格或范围内。这也可以是一系列单元格，例如B5:G25或在我的示例中是单个单元格Range("A1")，并且图片将覆盖该范围内的所有单元格。
回答by Joe Philipp
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
回答by Gary's Student
You need a Subrather than a Function.
您需要Sub而不是Function。
EDIT#1:
编辑#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
