VBA代码求助,菜鸟不太懂,求excel宏高手帮我在每一句后面标个释义,非常谢谢。

2024-11-08 12:07:53
推荐回答(2个)
回答(1):

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 '如果range对象的数量不等于1 则退出过程
Target.Offset(-3, -5).Select '选中相对于 当前内容改变的单元格 偏移-3行 -5列位置的单元格
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

回答(2):

Sub fp1()
Sheet6.Range("D38").Formula = "=D39" '在sheet6的D38单元格输入=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 加入选中的区域不等于1个单元格,退出
Target.Offset(-3, -5).Select '选中大单元格像左便宜3个单元格,向上偏移5个单元格,选中偏移后单元格
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