VBA 插入批注

Sub pictopz()    Dim cell As Range, fd, t, w As Byte, h As Byte    Selection.ClearComments    If Selection(1) = "" Then MsgBox "不能选择空白区。", 64, "提示": Exit SubOn Error Resume Next '错误继续    On Error GoTo err    Set fd = Application.FileDialog(msoFileDialogFolderPicker)    '允许用户选择一个文件夹    If fd.Show = -1 Then        t = fd.SelectedItems(1)    '选择之后就记录这个文件夹名称    Else        Exit Sub    '否则就退出程序    End If    w = Application.InputBox("您希望插入的图片显示多宽？" & Chr(10) & "Excel默认宽度为3.39，你可以输入1-15之间的数据。" & Chr(10) & "小于1时当做1计算。", "确认宽度", 3.39, , , , , 2)    h = Application.InputBox("您希望插入的图片显示多高？" & Chr(10) & "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 t & "\" & cell.Text & ".jpg"                .ScaleWidth w / 3.39, msoFalse, msoScaleFromTopLeft                .ScaleHeight h / 2.09, msoFalse, msoScaleFromTopLeft            End With            cell.Offset(1, 0).Select            .Visible = False        End With    Next    Exit Suberr:    ActiveCell.ClearComments    MsgBox "未找到同名的JPG图片！", 64, "提示"End Sub