许四金许四金许仔许仔？

Sub 批注图片()
Dim cell As Range, fd, t, w As Byte, h As Byte
Selection.ClearComments
If Selection(1) = "" Then MsgBox "不能选择空白区。", 64, "提示": Exit Sub
'On Error GoTo loo
On Error Resume Next
'Set fd = Application.FileDialog(msoFileDialogFolderPicker) '允许用户选择一个文件夹
'If fd.Show = -1 Then
' t = fd.SelectedItems(1) '选择之后就记录这个文件夹名称
'Else
' Exit Sub '否则就退出程序
'End If
w = 2.5 'Application.InputBox("您希望插入的图片显示多宽？" & "EXCEL默认宽度为3.39，您可输入1-15之间的数据。" & Chr(10) & "小于1时当做1计算。", "确认宽度", 3.39, , , , , 2)
h = 2.5 ' Application.InputBox("您希望插入的图片显示多高？" & "EXCEL默认宽度为2.09，您可输入1-15之间的数据。" & Chr(10) & "小于1时当做1计算。", "确认宽度", 2.09, , , , , 2)
'If w < 1 Or h < 1 Then w = 3.39: h = 2.09
'If w > 15 Or h > 15 Then MsgBox "原则上您的图片可以显示这么大，" & Chr(10) & "不过有必要吗？请重新输入1-15之间的数", 64, "提示": Exit Sub
For Each cell In Selection
With cell.AddComment
.Visible = True
.Text Text:=""
.Shape.Select True
With Selection.ShapeRange
.Fill.UserPicture "C:\工作\商品管理\基础资料\产品图片" & "\" & cell.Text & ".jpg"
.ScaleWidth w / 3.39, msoFalse, msoScaleFromTopLeft
.ScaleHeight h / 2.09, msoFalse, msoScaleFromTopLeft
End With
cell.Offset(1, 0).Select
.Visible = True
End With
loo:
Next
Exit Sub
'err:
' ActiveCell.ClearComments
' MsgBox "未找到同名的JPG图片", 64, "提示"
End Sub