【VBA】批量插入图片

解决如下问题：

• 需要批量导入图片到Excel
• 图片放在一个文件夹中
• 图片有严格的顺序关系，即按照：共通名_编号的方式命名。
• 图片格式统一，即均为同一格式。

有两种方式可以插入图片到Excel中，其一为插入快捷方式，在自己的电脑可以显示，但在别人的电脑显示不了。

其二为添加图片到文件，也有几种保存方式，可以选择。

> 现约定：

• 图片文件夹为PicPath
• 图片的共通名为PicComName
• 图片导入到Excel的InstLine and InstCol 单元格中
• 图片的间隔行为AddLine
• 图片的宽，高分别为PicWit and PicHgt
• 最小/大编号数字：MinNum/MaxNum
• 数字格式：FormatNum（例如：1用0001表示，即数字为4位，不足4位用0补齐。）
• 图片格式：FormatPic（例如：jpg，png等）

第一种方式

插入链接

    Sub InsertImg()
    ‘此处省去变量申请
    Dim Index As Integer
    Dim PicName As String
    For Index = MinNum To MaxNum
        RangeIset = InstCol & InstLine
        PicName = PicPath & "\" & PicComName & Format(Index,FormatNum) & "." & FormatPic
        Range(RangeIset).Select
        ActiveSheet.Pictures.Insert(PicName).Select
        ’如果是一溜排下来，就讲AddLine设置为1，其他同理，主要是要适用非一个单元格一个图片的情况。
        InstLine = InstLine + AddLine
    Next
    End Sub

以上是插入图片的一种方式，但是该图片只在自己电脑可见，那么怎么样才能将图片与文档一起保存？

第二种方式

插入图片

以上的变量均沿用

• 第一种方案是插入链接的形式，大大减少了该文档的大小，但是，也有诸多限制，本方案是直接将图片保存在Excel中，同样也有很多限制。适用于不同的需求。

    Sub InstSavePic()
    '基本骨架沿用，变量声明取消。
    For Index = MinNum To MaxNum
        RangeIset = InstCol & InstLine
        PicName = PicPath & "\" & PicComName & Format(Index,FormatNum) & "." & FormatPic
        Range(RangeIset).Select
         With ActiveCell
            ActiveSheet.Shapes.AddPicture Filename:=PicName, _
                LinkToFile:=msoFalse , SaveWithDocument:=msoTrue, _
                Left:=.Left, Top:=.Top, Width:=PicWit, Height:=PicHgt
        End With
        ’如果是一溜排下来，就讲AddLine设置为1，其他同理，主要是要适用非一个单元格一个图片的情况。
        InstLine = InstLine + AddLine
    Next
    End Sub

这里说明以下AddPicture的几个参数，分别表示说明意思。

AddPicture的原型为expression.AddPicture(FileName, LinkToFile, SaveWithDocument, Left, Top, Width, Height

其中

• FileName
  • 文件名（包含地址）
• LinkToFile：图片和文件的关系
• SaveWithDocument：保存文档时与图片的关系
• Left : 图片的左段离左边线的距离
• Top : 图片的顶端离顶端的距离
• Width : 图片的宽度
• Height：图片的高度。
  • 以上以磅为单位

说明：
    Left:=.Left表明插入图片的坐边线和该活动单元格的左边线的距离一样。同理Top
    当然也可以将图片填充为一个单元格。
    Width:=.Width（同理Height）即可。

若不明白可以百度AddPicture.

--20160218