VBA将图片写入单元格批注中
将图片写入批注中,其本质是将图片设置为批注背景。下面是我改写的一个过程。希望对大家有所帮助。
其功能是选择图片当批注背景。
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将图片写入单元格批注中](https://zawen.net/post/9.html)
♡♡♡转载请保留上面信息♡♡♡