Sub fp1()
Sheet6.Range("D38").Formula = "=D39"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next '设置错误处理
Application.ScreenUpdating = False '关闭屏幕刷新
Dim Mypath As String
Dim Myname As String
Dim Inrange As Range
Dim Mytext As String
Dim Myaddress As String
Dim pictemp As Variant
If Target.Count <> 1 Then Exit Sub
Target.Offset(-3, -5).Select
Mytext = Target.Value
ActiveSheet.Pictures(Mytext).Delete '删除单元格中原来的图片
picPath = ThisWorkbook.Path & "\Seal Library\" & Mytext & ".jpg" '定义插入图片的地址
Set pictemp = ActiveSheet.Pictures.Insert(picPath) '插入图片
pictemp.Name = Mytext '设定所插入图片的名称
With pictemp.ShapeRange
.PictureFormat.TransparentBackground = msoTrue
.PictureFormat.TransparencyColor = RGB(255, 255, 255)
End With
Set pictemp = Nothing '重置图片对象
Application.ScreenUpdating = True '打开屏幕刷新
Sheet1.Activate
End Sub
Sub fpsc1()
ActiveSheet.DrawingObjects.Delete
End Sub
一个都对不上,汗