VBA插入图片了解一下

微信公众号原文

系统：Windows 7
软件：Excel 2010

使用场景or困惑

• 在做问题单自动生成的系统中，常会遇到一个这样的问题，对某一问题需要加入图片描述
• 因为这个问题是固定类问题，定期只需更新该问题相关的数据即可，对问题的图片描述是不变的
• 那么能不能用VBA来插入图片，这个图片每次的大小和位置保存不变

示例：在B2：F17中插入一张图片

逻辑过程

1. 根据目标区域（行高列宽保持一致）大小插入一个矩形框
2. 在矩形框中填充图片即可

代码

Sub 插入图片()
    Rem>>
    Rem>>
    Set sht = ThisWorkbook.Worksheets("示例")
    addr = ThisWorkbook.Path & "\图片"
    photoAddr = addr & "\" & "1.jpg"

    sht.Shapes.AddShape(msoShapeRectangle, _
    sht.Range("B2").Left, sht.Range("B2").Top, _
    sht.Range("B2").Width * 5, sht.Range("B2").Height * 16).Select  'msoShapeRectangle是类别，是一个矩形

    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Line.Visible = msoTrue

    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture photoAddr
        .TextureTile = msoFalse
    End With

End Sub

代码截图

执行结果

部分代码解读

    sht.Shapes.AddShape(msoShapeRectangle, _
    sht.Range("B2").Left, sht.Range("B2").Top, _
    sht.Range("B2").Width * 5, sht.Range("B2").Height * 16).Select

AddShape功能官方解读

1. 定义好形状，这里的msoShapeRectangle是一个矩形
2. left/Top指定图形左上角，这里指定B2单元格为整个图形的左上角
3. 图形宽度为单元格B2的5倍，高度为单元格B2的16倍，所以要求这个区域单元格的宽度高度相同
4. 其它有趣的图形类型

图形类型

msoShape16pointStar十六角星

msoShapeBevel凹凸效果

msoShapeHeart心形

---

以上为本次的学习内容，下回见

如发现有错误，欢迎留言指出

---

更多精彩，请关注微信公众号
扫描二维码，关注本公众号