VBA EXCEL图片匹配宏修改

2025年03月01日 15:34

有2个网友回答

网友（1）：

Sub Button1_Click()
Dim MR As Range
For Each MR In Selection
If Not IsEmpty(MR) Then
MR.Select
ML = MR.Left + 1
MT = MR.Top + 1
MW = MR.Width - 2
MH = MR.Height - 2

ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
Selection.ShapeRange.Fill.UserPicture "C:\123\test.bmp"
Selection.ShapeRange.Line.Visible = msoFalse
End If
Next
End Sub

网友（2）：

Sub 按钮48_单击()
On Error Resume Next
Dim MR As Range
For Each MR In Selection
If Not IsEmpty(MR) Then
MR.Select
ML = MR.Left + 1
MT = MR.Top + 1
MW = MR.Width - 2
MH = MR.Height - 2
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
Selection.ShapeRange.Fill.UserPicture _
ActiveWorkbook.Path & "\pic\" & MR.Value & ".jpg"
End If
Next
Selection.ShapeRange.Line.Visible = msoFalse '设置为无边框
End Sub