求大神帮我给这段VBA代码写个说明,菜鸟不太懂,求excel宏高手帮我在每一句后面标个释义,非常谢谢。

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

第1个回答  2016-07-25
Sub test()
Dim PathB$, CopyPath$, SearchStr$
Dim Rg As Range
PathB = "D:\复制\b.xls"
''B文件路径
CopyPath = "d:\目标文件夹\"
''复制文件夹路径
SearchStr = InputBox("请输入内容", "提示")
''弹出输入框输入内容
If SearchStr = "" Then Exit Sub
''没有输入退出过程
Set Rg = Columns(1).Find(SearchStr, lookat:=xlWhole)
''在现有工作表第一列搜索输入内容
If Rg Is Nothing Then
''如果未搜索到指定内容
MsgBox "未找到输入内容"
''弹出提示
Else
''如果搜索到指定内容
Dim WB As Workbook
Set WB = Workbooks.Open(PathB)
''打开b工作簿
'''将A16的信息复制到Excel15014的AK1:AZ2中;将B16的信息复制到excel15014的
''I5:AA6单元格中;将D16的信息复制到excel15014的I7:AA8单元格中;将E16的''
''信息复制到excel15014的I9:AA10单元格中等等
with WB.Sheets(1)
.Cells(1, "ak")=rg
.Cells(5, "i")=rg.offset(,1)
.Cells(7, "i")=rg.offset(,3)
.Cells(9, "i")=rg.offset(,4)
end with
On Error Resume Next
''容错处理,文件夹已存在继续执行
MkDir CopyPath & SearchStr
''''在目标文件夹下,建立以搜索内容命名的文件夹B
'On Error GoTo 0
''回到正常错误处理
WB.SaveAs CopyPath & SearchStr & "\" & SearchStr & ".xls", 50
''B文件重命名为搜索内容,并保存在新建的文件夹B
WB.Close True
''保存更改内容并关闭b文件
End If
End Sub
''三个问题回答你三遍,你能不采纳么?追问

一个都对不上,汗

相似回答