发布网友 发布时间:2024-10-04 01:19
共1个回答
热心网友 时间:2024-10-17 22:47
你原先代码我测试没错的, 不知道电脑什么问题, 我重新写了 图片批量导入 代码Sub 图片批量导入()Dim r%, i%, j%, n%, ro%, col%, sh As Worksheet, s As Shape, rng As Range, pathstr As String, pname As StringOn Error Resume Nextpathstr = "D:\"Set fso = CreateObject("scripting.FileSystemObject")For n = 3 To 5Set sh = Sheets(n)sh.Activate For Each s In sh.Shapes If s.Type 8 Then s.Delete Next col = WorksheetFunction.CountA(sh.Rows(1)) ro = WorksheetFunction.CountA(sh.Columns(2)) For i = 1 To ro For j = 1 To col Set rng = sh.Cells(18 * i - 17, 7 * j - 5).Offset(1, 0).Resize(16, 6) pname = sh.Cells(18 * i - 17, 7 * j - 5).Text & ".jpg " If fso.fileexists(pathstr & pname) Then ActiveSheet.Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.Width, rng.Height).Select Selection.ShapeRange.Fill.UserPicture pathstr & pname End If Next j Next iNext nEnd Sub