Excel-将文件夹中的图像插入到单元格中

我想获得一个文件夹的所有图像，并开始逐个插入它们，以缓慢增加Excel中的单元格。 例如，图片1应插入单元格E1，然后插入图片2单元格E2等

我目前的代码只能从这个目录中获得1张图片，并将其插入硬编码的单元格中：

Sub Insert() Dim myPict As Picture Dim PictureLoc As String PictureLoc = "C:\MyFolder\Picture1.png" With Range("E1") Set myPict = ActiveSheet.Pictures.Insert(PictureLoc) .RowHeight = myPict.Height myPict.Top = .Top myPict.Left = .Left myPict.Placement = xlMoveAndSize End With End Sub 

Answer 1

尝试…

 Option Explicit Sub Insert() Dim strFolder As String Dim strFileName As String Dim objPic As Picture Dim rngCell As Range strFolder = "C:\Users\Domenic\Pictures\Saved Pictures\" 'change the path accordingly If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\" End If Set rngCell = Range("E1") 'starting cell strFileName = Dir(strFolder & "*.png", vbNormal) 'filter for .png files Do While Len(strFileName) > 0 Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName) With objPic .Left = rngCell.Left .Top = rngCell.Top .Height = rngCell.RowHeight .Placement = xlMoveAndSize End With Set rngCell = rngCell.Offset(1, 0) strFileName = Dir Loop End Sub 

要将LockAspectRatio属性设置为False，并将图片的宽度设置为单元格的宽度…

 With objPic .ShapeRange.LockAspectRatio = False .Left = rngCell.Left .Top = rngCell.Top .Width = rngCell.Width .Height = rngCell.RowHeight .Placement = xlMoveAndSize End With 

希望这可以帮助！