关于批注填充图片保持纵横比代码怎么写?

wanjie2019

找不到以前的论坛名字了,看到爱疯,突然想起班主任:7dong502  班长豆浆  君柳,小妖,秦始皇,1680,wayy老师,领风飞翔,开辆小富康,搁浅2008,米仓,  ....等等.想起当年一起聚集在聊天室学习的日子,事过多年相信很多人都离开论坛了

wanjie2019

爱疯 发表于 2019-4-15 16:09
我只是喜欢看看这些，参与回答一下而已
哪儿什么大师，还不是经常碰到不会的内容。
之前你的论坛用户名 ...

能帮我找回08年的论坛密码吗?  用户名:万杰   

爱疯

wanjie2019 发表于 2019-4-15 17:26
找不到以前的论坛名字了,看到爱疯,突然想起班主任:7dong502  班长豆浆  君柳,小妖,秦始皇,1680,wayy老师,领 ...

额。。。。十天前说离开，那一定让人误会了

ahn

插入批注图片并维持图片宽高比。

wlchen

Sub 批量添加注释图片()
    Dim rng As Range
    For I = 3 To Range("B" & Rows.Count).End(xlUp).Row
        '遍历次数为,I列最大行,最后一个非空单元格的行数
        Set rng = Cells(I, "B")
        Set rngd = Cells(I, "d")
        文件名全称 = Dir(ThisWorkbook.Path & "\" & rngd.Value & "\" & rng.Value & ".jpg")
        '本工作表相对位置,查找F3名字的文件,找不到则返回空值
        If 文件名全称 <> "" Then
            图片路径 = ThisWorkbook.Path & "\" & rngd.Value & "\" & 文件名全称 '本工作表的相对位置+文件名称(具体路径)
            ActiveSheet.Pictures.Insert(图片路径).Select '插入图片并选中
            W = Selection.Width '对W进行赋值等于选中图片的宽度
            H = Selection.Height '对H进行赋值等于选中图片的高度
            系数 = H / 400 '所有图片高度设置为300像素
            Selection.Delete '选中的图片删除
            rng.ClearComments '清除注释
            rng.AddComment '添加注释
            rng.Comment.Visible = False '注释选中可见
            rng.Comment.Text Text:="" '注释名为空
            rng.Comment.Shape.Fill.UserPicture 图片路径 '注释图片路径
            rng.Comment.Shape.Height = H / 系数 '图片高度
            rng.Comment.Shape.Width = W / 系数 '图片宽度
        End If
    Next
End Sub