VBA判断当前路径下格式为png和jpg的图片并插入到另一个工作簿中工作表的指定单元格
以下是一个VBA代码示例,可以实现判断当前路径下格式为png和jpg的图片,并将其插入到另一个工作簿中工作表的指定单元格。
Sub InsertImages()
Dim sourcePath As String
Dim targetWorkbook As Workbook
Dim targetWorksheet As Worksheet
Dim targetCell As Range
Dim file As String
' 设置源路径
sourcePath = "C:\Your\Source\Path\"
' 打开目标工作簿
Set targetWorkbook = Workbooks.Open("C:\Your\Target\Workbook.xlsx")
' 设置目标工作表和目标单元格
Set targetWorksheet = targetWorkbook.Sheets("Sheet1") ' 更改为目标工作表的名称
Set targetCell = targetWorksheet.Range("A1") ' 更改为目标单元格的地址
' 循环遍历源路径下的所有文件
file = Dir(sourcePath & "*.*")
Do While file <> ""
' 判断文件是否为png或jpg格式
If InStr(1, file, ".png", vbTextCompare) > 0 Or InStr(1, file, ".jpg", vbTextCompare) > 0 Then
' 插入图片到目标工作表的指定单元格
targetWorksheet.Pictures.Insert(sourcePath & file).Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse ' 可根据需要调整图片大小
.ShapeRange.Width = targetCell.Width
.ShapeRange.Height = targetCell.Height
.ShapeRange.Top = targetCell.Top
.ShapeRange.Left = targetCell.Left
End With
' 移动目标单元格到下一列
Set targetCell = targetCell.Offset(0, 1)
End If
' 继续下一个文件
file = Dir
Loop
' 关闭目标工作簿并保存
targetWorkbook.Close SaveChanges:=True
' 清理对象
Set targetCell = Nothing
Set targetWorksheet = Nothing
Set targetWorkbook = Nothing
End Sub
请将代码中的"C:\Your\Source\Path\"更改为你的源路径,"C:\Your\Target\Workbook.xlsx"更改为你的目标工作簿路径和文件名,"Sheet1"更改为你的目标工作表名称,"A1"更改为你的目标单元格地址。
此代码会遍历源路径下的所有文件,并判断文件是否为png或jpg格式。对于符合条件的文件,它会将其插入到目标工作表的指定单元格,并将目标单元格移动到下一列。最后,它会保存并关闭目标工作簿。
请注意,在运行此代码之前,请确保目标工作簿已存在,并且目标工作表和目标单元格的设置是正确的
原文地址: https://www.cveoy.top/t/topic/hY3h 著作权归作者所有。请勿转载和采集!