|
各位老师大家好！ 写入图片问题 我想在K2单元格中输入319655或312890，图片自动写入A2,F2,A11,F11这4个框中，随着K2单元格中号码更换这4个框中的图片也自动更换，（删除旧图片更换新图片）如果换号码不能实现清除旧图片，我在上面用了个“删除图片”按纽，删除后在K2中输入号码又能写入新图片，我的VBA写得差不多了，就是图片同时写入4个框中或清除实现不了！谢谢大家！ 我的旧VBA就是在Ａ2, a11中输放319655或312890会有图片，请老师试试
Option Explicit
Private Sub Worksheet_Change(ByVal T As Range)
Dim URow&, myPath$, Pic As Object
myPath = ThisWorkbook.Path
URow = Range("b65536").End(xlUp).Row
On Error Resume Next
If T.Column = 1 And T.Count = 1 _
And T.Row Mod 9.15 = 2 Then
Pic.Delete
Application.EnableEvents = False
' Me.Unprotect '鎖定代碼
Me.Shapes("Picture" & T.Row).Delete
T.Offset(, 0).Select
Set Pic = ActiveSheet.Pictures.Insert(myPath & "\图片\" & T.Value & ".jpg")
Pic.ShapeRange.LockAspectRatio = True
Pic.Name = Split(Pic.Name)(0) & T.Row
With Pic.ShapeRange
'如果图片高宽比比单元格大，说明图片太高，只需调整图片高度
If .Height / .Width > T.Offset(, 0).MergeArea.Height / T.Offset(, 0).MergeArea.Width Then
.Height = T.Offset(, 0).MergeArea.Height
'调整位置
.Top = T.Offset(, 0).MergeArea.Top
.Left = T.Offset(, 0).MergeArea.Left + (T.Offset(, 0).MergeArea.Width - .Width) / 2
'如果图片高宽比比单元格小，说明图片太宽，只需调整图片宽度
Else
.Width = T.Offset(, 0).MergeArea.Width
'调整位置
.Left = T.Offset(, 0).MergeArea.Left
.Top = T.Offset(, 0).MergeArea.Top + (T.Offset(, 0).MergeArea.Height - .Height) / 2
End If
End With
Me.Shapes("Picture" & T.Row).Placement = xlMoveAndSize
'Me.Protect '鎖定代碼
Application.EnableEvents = True
End If
End Sub
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-7-6 22:50
楼主
