VBA将图片写入单元格批注中

作者:仇朝权 时间:23-09-02 阅读数:344人阅读

将图片写入批注中,其本质是将图片设置为批注背景。下面是我改写的一个过程。希望对大家有所帮助。

其功能是选择图片当批注背景。

Sub imgToComm()
'插入图片当注释背景 增加日期:2023年8月11日
'完善于 2023年8月12日
    On Error Resume Next
    Dim Cr As FileDialog, imgFileStr$, imgW, imgH, W, H, SelAddStr$, oldCommStr$
    SelAddStr = Selection(1).Address    '多选 只 对第一格单元 添加图片备注
    Range(SelAddStr).Select
    Set Cr = Application.FileDialog(msoFileDialogFilePicker)
    With Cr
        '.ButtonName = "添加"
        .Title = "请浏览&选择一张图片文件"
        .AllowMultiSelect = False   '是否运行多选图片
        .Filters.Clear
        .Filters.Add "支持的图片文件(*.JPG,*.PNG,*.GIF,*.TIFF,*.JPEG,*.BMP)", "*.JPG,*.PNG,*.GIF,*.TIFF,*.JPEG,*.BMP"
    End With
If Cr.Show = True Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    'Image1.Picture = LoadPicture(cr.SelectedItems(1))
    'Image1.PictureSizeMode = fmPictureSizeModeStretch
    'MsgBox cr.SelectedItems(1)
    imgFileStr = Cr.SelectedItems(1)                '只取最后一个图片
    ActiveSheet.Pictures.Insert(imgFileStr).Select     '插入图片并选中
    imgW = Selection.Width                            '对W进行赋值等于选中图片的宽度
    imgH = Selection.Height                            '对H进行赋值等于选中图片的高度
    Selection.Delete                                   '选中的图片删除
    If imgH > 420 Then  '//图片高度大于420,笔记本屏幕不好显示
        H = 420
        W = Int(H * imgW / imgH)
    Else
        W = imgW
        H = imgH
    End If
    'MsgBox W & "*" & H
    With Selection
        oldCommStr = .Comment.Text
        .ClearComments
        .AddComment
        If Len(oldCommStr) > 0 Then .Comment.Text Text:=oldCommStr  '保留文本批注
        .Comment.Shape.Height = H
        .Comment.Shape.Width = W
        .Comment.Shape.Fill.UserPicture imgFileStr
        .Comment.Visible = False
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
End Sub


[本文转自仇朝权随笔_VBA将图片写入单元格批注中](http://www.zawen.net/post/9.html)

分享到:

♡♡♡转载请保留上面信息♡♡♡

发表评论