1秒插100张图!这个Excel神技让我准时下班了!

Sub 批量插图() '适配多种图片格式    On Error GoTo ErrorHandler    Dim imagePath As String    Dim fso As Object    Dim pic As String    Dim ML As Double, MT As Double, MW As Double, MH As Double    Dim MR As Range    Dim shape As shape    Dim extensions As Variant, ext As Variant    extensions = Array(".jpg", ".jpeg", ".png", ".gif", ".bmp")    imagePath = "D:\图片汇总\"    Set fso = CreateObject("Scripting.FileSystemObject")    For Each ext In extensions    For Each MR In Selection        If Not IsEmpty(MR) Then            pic = imagePath & CStr(MR.Value) & ext            If fso.FileExists(pic) Then                ML = MR.Offset(0, 1).Left                MT = MR.top                MW = MR.Offset(0, 1).Width                MH = MR.Height                Set shape = ActiveSheet.Shapes.AddPicture( _                    fileName:=pic, _                    LinkToFile:=msoFalse, _                    SaveWithDocument:=msoTrue, _                    Left:=ML, _                    top:=MT, _                    Width:=MW, _                    Height:=MH)                With shape                    .Placement = xlMoveAndSize                    .Line.Visible = msoFalse                    .SoftEdge.Type = msoSoftEdgeType1                End With            End If        End If    Next    NextCleanUp:    Set fso = Nothing    Exit SubErrorHandler:    MsgBox "错误 " & err.Number & ": " & err.Description & vbCrLf & _           "发生在单元格 " & MR.Address, vbExclamation    Resume CleanUpEnd Sub