Sub 插入图片批注()
Dim Cmt As Comment
Dim msg
msg = MsgBox("使用说明:请确认您的图片文件存在与此文件同一目录下的名称为picture的文件夹中。并选中需要要添加图片批注的单元格。")
If msg = 1 Then
On Error Resume Next
Dim MR As Range
Dim Pics As String
For Each MR In Selection
If Not IsEmpty(MR) Then
MR.Select
MR.AddComment
MR.Comment.Visible = False
MR.Comment.Text Text:=""
MR.Comment.Shape.Fill.UserPicture PictureFile:=ActiveWorkbook.Path & "\picture\" & MR.Value & ".jpg"
End If
Next
End If
'修改批注长宽
For Each Cmt In ActiveSheet.Comments
Cmt.Parent.Comment.Shape.Width = 300
Cmt.Parent.Comment.Shape.Height = 150
Next Cmt
End Sub
Dim Cmt As Comment
Dim msg
msg = MsgBox("使用说明:请确认您的图片文件存在与此文件同一目录下的名称为picture的文件夹中。并选中需要要添加图片批注的单元格。")
If msg = 1 Then
On Error Resume Next
Dim MR As Range
Dim Pics As String
For Each MR In Selection
If Not IsEmpty(MR) Then
MR.Select
MR.AddComment
MR.Comment.Visible = False
MR.Comment.Text Text:=""
MR.Comment.Shape.Fill.UserPicture PictureFile:=ActiveWorkbook.Path & "\picture\" & MR.Value & ".jpg"
End If
Next
End If
'修改批注长宽
For Each Cmt In ActiveSheet.Comments
Cmt.Parent.Comment.Shape.Width = 300
Cmt.Parent.Comment.Shape.Height = 150
Next Cmt
End Sub