VBA批注图片批量导出并重命名图片名字

布塔

各位大佬好：请问如何将，VBA批注图片批量导出到当前文件目录，并重命名图片，值是批注单元格的值，谢谢

huanglicheng

如果需要经常使用，可以试试SoSo工具集9.0中 的 批量导出批注中的图片

布塔

huanglicheng 发表于 2021-3-8 15:27
如果需要经常使用，可以试试SoSo工具集9.0中 的 批量导出批注中的图片

谢谢你，我试试

布塔

huanglicheng 发表于 2021-3-8 15:27
如果需要经常使用，可以试试SoSo工具集9.0中 的 批量导出批注中的图片

您好，试用了一下这个工具，版本是V9.0 20200108版本，OFFICE版本是365，导出图片后所有显示都是空白的，数据为5KB

huanglicheng

我没有在365版本中运行过，不过我在其他版本中都可以。

wang-way

huanglicheng 发表于 2021-3-9 14:42
我没有在365版本中运行过，不过我在其他版本中都可以。

不是web不支持

考试加油站

test.rar (646.97 KB, 下载次数: 0)

2021-3-9 18:54 上传

点击文件名下载附件

考试加油站

Sub 导出批注中的图片()                                        '此法得到的文件体积最小
    Dim rng As Range, Flnm$
    Dim Ht, WD
    Set sh = ActiveSheet
    For Each rng In sh.Cells.SpecialCells(xlCellTypeComments)
        If rng.Comment.Shape.Fill.Type = msoFillPicture Then

            With rng.Comment
                .Visible = True
                With .Shape
                    Ht = .Height
                    WD = .Width
                    .CopyPicture 1, 2                 '
                End With
                .Visible = False
            End With
            If Dir(ThisWorkbook.Path & "\待导出图片", 16) = "" Then MkDir ThisWorkbook.Path & "\待导出图片"
            Flnm = ThisWorkbook.Path & "\待导出图片\" & rng.Value & ".jpg"
            With sh.ChartObjects.Add(0, 0, WD, Ht).Chart    '
                .Paste
                .Export Flnm, "jpg"
                .Parent.Delete
            End With
        End If
    Next
    MsgBox "已全部导出到待导出图片文件夹中，请查看"
End Sub

wang-way

厉害呀，学习了