Excel批量插入学籍照片的宏代码 Sub InsertPic() On Error Resume Next Sheets(1).Select Sheets(1).Delete Sheets("照片").Select Sheets("照片").Copy Before:=Sheets("照片") Cells.Select Range("A2").Activate Selection.Copy Selection.PasteSpecial Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("照片 (2)").Select Sheets("照片 (2)").Name = 1 Sheets("1").Select sPath = "d:\pic\" Application.ScreenUpdating = False With ThisWorkbook.Sheets("1") 'i = 3 Paste:=xlPasteValues, 'x = 1 For i = 3 To Int(Range("b2") / 6) * 2 + 3 Step 2 For x = 1 To 6 If .Cells(i, x) <> "" Then sfileName = sPath & .Cells(i, x) Cells(i, x).Select ActiveSheet.Pictures.Insert(sfileName).Select Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.IncrementLeft 1.2 Selection.ShapeRange.IncrementTop 1.2 If Err <> 0 Then 'MsgBox .Cells(i, x) & "不存在" sfileName = sPath & "没有照片.jpg" Cells(i, x).Select ActiveSheet.Pictures.Insert(sfileName).Select Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.IncrementLeft 1.2 Selection.ShapeRange.IncrementTop 1.2 Err = 0 End If End If Next x Next i End With Application.ScreenUpdating = True End Sub 本文来源：https://www.wddqw.com/doc/091c3f511411cc7931b765ce0508763231127463.html