我想将文件夹中的所有图像一张一张地插入到 Excel 中的递增单元格中。
例如,图片 1 应插入单元格 E1,然后图片 2 插入单元格 E2,依此类推。
我的代码只能在硬编码单元格中插入此目录中的一张图片:
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
Try...
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
希望这可以帮助!
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)