VBA自动将当前路径下PNG/JPG图片插入Excel指定单元格

{"title":"VBA自动将当前路径下PNG/JPG图片插入Excel指定单元格","description":"本篇文章提供了一个VBA代码示例，该代码可以自动识别当前路径下的PNG和JPG格式的图片，并将它们插入到另一个工作表的指定单元格中。代码简单易懂，并附带详细的注释，方便理解和修改。","keywords":"VBA, 图片插入, Excel, 自动化, PNG, JPG, 当前路径","content":""""vba\nSub InsertImages()\n Dim imgPath As String\n Dim imgName As String\n Dim imgExtension As String\n Dim imgType As String\n Dim imgCount As Integer\n Dim targetSheet As Worksheet\n Dim targetCell As Range\n Dim i As Integer\n \n ' 设置目标工作表和单元格\n Set targetSheet = ThisWorkbook.Sheets("Sheet2")\n Set targetCell = targetSheet.Range("A1")\n \n ' 获取当前路径\n imgPath = ThisWorkbook.Path & "\"\n \n ' 初始化图片计数器\n imgCount = 0\n \n ' 循环遍历当前路径下的所有文件\n imgName = Dir(imgPath)\n Do While imgName <> ""\n ' 获取文件扩展名\n imgExtension = LCase(Right(imgName, Len(imgName) - InStrRev(imgName, ".")))\n \n ' 判断文件是否为png或jpg格式\n If imgExtension = "png" Or imgExtension = "jpg" Then\n ' 设置图片类型\n If imgExtension = "png" Then\n imgType = "PNG"\n Else\n imgType = "JPEG"\n End If\n \n ' 插入图片到目标单元格\n targetSheet.Pictures.Insert(imgPath & imgName).Select\n With Selection\n .ShapeRange.LockAspectRatio = msoFalse\n .ShapeRange.Width = targetCell.Width\n .ShapeRange.Height = targetCell.Height\n .ShapeRange.Left = targetCell.Left\n .ShapeRange.Top = targetCell.Top\n End With\n \n ' 移动目标单元格\n Set targetCell = targetCell.Offset(1, 0)\n \n ' 增加图片计数器\n imgCount = imgCount + 1\n End If\n \n ' 继续遍历下一个文件\n imgName = Dir\n Loop\n \n ' 显示插入的图片数量\n MsgBox "共插入了 " & imgCount & " 张图片。"\nEnd Sub\n"""\n\n请将上述代码复制到一个VBA模块中，并根据需要修改目标工作表和单元格的名称（在代码中标有注释的部分）。然后，运行InsertImages宏即可。该宏将遍历当前路径下的所有文件，如果文件是png或jpg格式，则将其插入到目标工作表的指定单元格中。在插入完成后，将显示插入的图片数量。\n