|
楼主 |
发表于 2021-4-14 19:02
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub 刷新5张照片()
Dim C$, PathName$
Dim MyShape1, MyShape2 As Shape
PathName = ThisWorkbook.Path & "\照片\"
On Error Resume Next
Sheets("侧贴").Shapes("PPPP1").Delete
Sheets("侧贴").Shapes("PPPP2").Delete
Sheets("侧贴").Shapes("PPPP3").Delete
Sheets("侧贴").Shapes("PPPP4").Delete
Sheets("侧贴").Shapes("PPPP5").Delete
C = Dir(PathName & Sheets("侧贴").[A6].Value & "*")
If C <> "" Then
With Sheets("侧贴").[A6:A7]
Set MyShape1 = Sheets("侧贴").Shapes.AddPicture(PathName & C, msoFalse, msoTrue, .Left, .Top, .Width, .Height)
MyShape1.Name = "PPPP1"
End With
End If
C = Dir(PathName & Sheets("侧贴").[C6].Value & "*")
If C <> "" Then
With Sheets("侧贴").[C6:C7]
Set MyShape1 = Sheets("侧贴").Shapes.AddPicture(PathName & C, msoFalse, msoTrue, .Left, .Top, .Width, .Height)
MyShape1.Name = "PPPP2"
End With
End If
C = Dir(PathName & Sheets("侧贴").[E6].Value & "*")
If C <> "" Then
With Sheets("侧贴").[E6:E7]
Set MyShape1 = Sheets("侧贴").Shapes.AddPicture(PathName & C, msoFalse, msoTrue, .Left, .Top, .Width, .Height)
MyShape1.Name = "PPPP3"
End With
End If
C = Dir(PathName & Sheets("侧贴").[G6].Value & "*")
If C <> "" Then
With Sheets("侧贴").[G6:G7]
Set MyShape1 = Sheets("侧贴").Shapes.AddPicture(PathName & C, msoFalse, msoTrue, .Left, .Top, .Width, .Height)
MyShape1.Name = "PPPP4"
End With
End If
C = Dir(PathName & Sheets("侧贴").[I6].Value & "*")
If C <> "" Then
With Sheets("侧贴").[I6:I7]
Set MyShape1 = Sheets("侧贴").Shapes.AddPicture(PathName & C, msoFalse, msoTrue, .Left, .Top, .Width, .Height)
MyShape1.Name = "PPPP5"
End With
End If
End Sub
|
|