快速批量在工作表插入图片

实例需求：在示例目录中有多个Excel文件，需要在每个文件的全部工作表中快速插入图片，图片文件位于同一目录中，文件名为Chart1.png，代码所在文件“Demo.xlsm”无需插入图片。

Sub Demo_InserPic()
    Dim FileName As String
    Dim Sht As Worksheet
    Application.ScreenUpdating = False
    spath = ThisWorkbook.Path & "\"
    FileName = Dir(spath & "*.xls*")
    img = ThisWorkbook.Path & "\Chart1.png"
    Do While FileName <> ""
        If UCase(ThisWorkbook.Name) <> UCase(FileName) And _
           Left(FileName, 1) <> "~" Then
            Set wk = Workbooks.Open(spath & FileName)
            For Each Sht In wk.Sheets
                Sht.Pictures.Insert img
            Next
            wk.Save
            wk.Close
        End If
        FileName = Dir()
    Loop
    Application.ScreenUpdating = True
End Sub

【代码解析】
第4行代码禁止屏幕更新。
第5行代码获取当前代码文件所在目录。
第6行代码查找当前目录中扩展名为“xls*”的文件。
第7行代码为图片文件的全路径。
第8~19行代码循环处理Excel文件。
第9~10行代码判断Dir查找结果是否为当前文件（Demo.xlsm），比较文件名时应使用Ucase或者Lcase进行转换，以免由于大小写不一致的误差。Left(FileName, 1) <> "~"用于排除临时文件。
第11行代码打开Excel文件。
第12~13行代码循环处理每个工作表。
第13行代码插入图片。
第15行代码保存工作簿。
第16行代码关闭工作簿。
第18行代码继续查找文件。
第20行代码恢复屏幕更新。

批量插入图片就是这么简单，学会这一招，从此告别996.