vba 将文件夹中的图像插入单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/45525719/
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
Insert images from folder into cells
提问by Iason
I want to insert all the images of a folder, one by one, to incrementing cells in Excel.
我想将文件夹的所有图像一张一张地插入到 Excel 中递增的单元格中。
For example, picture 1 should be inserted in cell E1, then picture 2 in cell E2, etc.
例如，图片 1 应插入单元格 E1，然后图片 2 插入单元格 E2，依此类推。
My code can only insert one picture from this directory in a hardcoded cell:
我的代码只能从该目录中的硬编码单元格中插入一张图片：
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
回答by Domenic
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
To set the LockAspectRatio property to False, and set the width of the picture to the width of the cell...
要将 LockAspectRatio 属性设置为 False，并将图片的宽度设置为单元格的宽度...
With objPic
.ShapeRange.LockAspectRatio = False
.Left = rngCell.Left
.Top = rngCell.Top
.Width = rngCell.Width
.Height = rngCell.RowHeight
.Placement = xlMoveAndSize
End With
Hope this helps!
希望这可以帮助！
