求高手帮助：批量插入同名照片到批注,如何设置批注显示图片为图片默认大小

KCFONG

you can amend the macro as
  
if fswith > xxx then fswith = yyy :fsheight =zzz

伱dē幸福

很感谢，终于找到这篇文章了  谢谢！！！

junckers

留印，学习

nicole麻麻

能不能模糊匹配，比如我图片和EXCEL内名称只前7位数字相同？

花匠的植物园

若存在没有图片的项目会弹出提示并停止继续运行。有办法让它跳过无图片的项目继续往后运行吗？ 谢谢

KCFONG

see if help you, but activewindow.heigh will be a bit larger.


Sub 批量插入同名照片到批注()
    Dim cell As Range, fd, t
    Selection.ClearComments
    If Selection(1) = "" Then MsgBox "不能选择空白区。", 64, "提示": Exit Sub
    On Error GoTo err
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)    '允许用户选择一个文件夹
    If fd.Show = -1 Then
        t = fd.SelectedItems(1)    '选择之后就记录这个文件夹名称
    Else
        Exit Sub    '否则就退出程序
    End If
   
    For Each cell In Selection
             ActiveSheet.Pictures.Insert(t & "\" & cell.Text & ".jpg").Select
             fswith = Selection.Width
             Fsheight = Selection.Height
             If Fsheight > ActiveWindow.Height Then Fsheight = ActiveWindow.Height
                Selection.Delete
        With cell.AddComment
            .Visible = True
            .Text Text:=""
            .Shape.Select True
              Selection.ShapeRange.Fill.UserPicture t & "\" & cell.Text & ".jpg"
            .Shape.Width = fswith   'Add these 2 statement
            .Shape.Height = Fsheight
            .Shape.Top = 0
            cell.Offset(1, 0).Select
            .Visible = False
        End With
    Next
    Exit Sub
err:
    ActiveCell.ClearComments
    MsgBox "未找到同名的JPG图片！", 64, "提示"
End Sub

小戴小花匠8622

{:soso_e154:}{:soso_e154:}有办法跳过无对应图片的项目，继续完后运行吗？
不弹出“未图片“的提示，继续往下运行~~~~~ 谢谢

KCFONG

  On Error GoTo err
CHANGE TO
ON ERROR RESUME NEXT

花匠的植物园

  我把代码中的“On Error GoTo err”改成“
ON ERROR RESUME NEXT”之后，，执行数时自动将无图片的项目给删除了，为什么呢？怎么能让他不被删除呢？

花匠的植物园

1.如果用“保留原尺寸”的代码，修改  On Error GoTo err 之后，没有图片的货号会被删除几个，不是全部被删除，但是确实被删了几个，不知道为什么会这样？

2.如果用“调整了长宽高”的代码，修改  On Error GoTo err 之后，执行的很顺利，没有图片的货号没有被删除，但是会显示一个空的批注，有办法不显示任何东西，直接跳到下一个吗？

谢谢！！！