大神帮忙看下

zhake123

大神帮忙看下这个宏，插入图片后原图片更名或删除后工作表内图片就没了，看看要怎样改？谢谢！


Sub 插入图片()
    Dim fileNames As Variant
    Dim fileName As Variant
    Dim fileFilter As String
ActiveSheet.Range("A2").Select
    '所有图片文件后面的括号为中文括号
    fileFilter = ("所有图片文件（*.jpg;*.bmp;*.png;*.gif）,*.jpg;*.bmp;*.png;*.gif")
    ChDrive "Y"
    ChDir "Y:\制造部\03_製造管理\生产管理看板写真\2023年\4月份\写真\"
    fileNames = Application.GetOpenFilename(fileFilter, , "请选择要插入的图片", , MultiSelect:=True)

    '循环次数
    Dim i As Single
    i = 0
    '忽略错误继续执行VBA代码，避免出现错误消息（数组fileNames为空时，会报错）
    On Error Resume Next
    '循环插入
    For Each fileName In fileNames

        '将图片插入到活动的工作表中&选中该图片
        With ActiveSheet.Pictures.Insert(fileName).Select

            '图片自适应单元格大小
            Dim picW As Single, picH As Single
            Dim cellW As Single, cellH As Single
            Dim rtoW As Single, rtoH As Single
            '鼠标所在单元格的宽度
            cellW = ActiveCell.Width
            '鼠标所在单元格的高度
            cellH = ActiveCell.Height
            '图片宽度
            picW = Selection.ShapeRange.Width
            '图片高度
            picH = Selection.ShapeRange.Height
            '重设图片的宽和高
            rtoW = cellW / picW * 0.95
            rtoH = cellH / picH * 0.95
            If rtoW < rtoH Then
                Selection.ShapeRange.ScaleWidth rtoW, msoFalse, msoScaleFromTopLeft
            Else
                Selection.ShapeRange.ScaleHeight rtoH, msoFalse, msoScaleFromTopLeft
            End If
            picW = Selection.ShapeRange.Width
            picH = Selection.ShapeRange.Height
            '锁定图片锁定纵横比
            Selection.ShapeRange.LockAspectRatio = msoTrue
            '图片的位置与大小随单元格变化而变化
            Selection.Placement = xlMoveAndSize
            '设置该图片的所在位置
            Selection.ShapeRange.IncrementLeft (cellW - picW) / 2 + cellW * i
            Selection.ShapeRange.IncrementTop (cellH - picH) / 2
        End With
        i = i + 1
    '下一个
    Next fileName

End Sub

3190496160

Insert方式插入的图片在04及以上版本中，仅仅是一个链接，所以，一旦图片更名或者删除，图片就没法显示了，可以使用Picturesadd方式插入图片，
没有附件只能这么跟你说

zhake123

请大神帮忙改一下，谢谢！

zhake123

3190496160 发表于 2023-4-27 11:59
Insert方式插入的图片在04及以上版本中，仅仅是一个链接，所以，一旦图片更名或者删除，图片就没法显示了， ...

能帮忙改一下吗？谢谢