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

我试图插入一个图像到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我可以看到它包含一个有效的path到我的硬盘驱动器上的图像。

我需要做什么来填充一个图像单元格？

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

是的，你可以添加一个图片到一个单元格，至less它适用于我：

 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而不是Function 。

编辑＃1 ：

确保你的path和文件名是正确的。 这是一个适用于我的例子：

 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