Excel批量插入学籍照片的宏代码

2022-04-08 08:30:05 文档大全网 [ 字体：小中大 ] [ 阅读： ]

【#文档大全网# 导语】以下是®文档大全网的小编为您整理的《Excel批量插入学籍照片的宏代码》，欢迎阅读！
学籍,批量,插入,代码,照片
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