|
楼主 |
发表于 2021-4-14 19:02
|
显示全部楼层
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 |
|