下面这段代码怎么改成用.shapes.addpicture方式，谢谢

szaf22222

Dim Rng As Range
Sub 插入图片()
     Set Rng = Selection
     FileName = Dir(ActiveWorkbook.Path & "\pic\")
     Do While FileName <> ""
         If IsPic(FileName) Then InsertPic (FileName)
         FileName = Dir
     Loop
     Range("B2").Select
End Sub
Function IsPic(FileName)
     If InStr("ai,bmp,bmz,cdr,cgm,dib,dwg,dxf,emf,emz,eps,exf,exif,fpx,gfa,gif,hdr,ico,jfif,jpe,jpeg,jpg,pcd,pct,pcx,pcz,pict,png,psd,raw,rle,svg,tga,tif,tiff,ufo,wmf,wmz", LCase(Right(FileName, Len(FileName) - InStrRev(FileName, ".")))) = 0 Then IsPic = False Else IsPic = True
End Function
Sub InsertPic(FileName)
     PicName = Left(FileName, InStrRev(FileName, ".") - 1)
     Rng.Select
     On Error Resume Next
     Selection.Find(What:=PicName, After:=ActiveCell, MatchCase:=True).Activate
     
     If Err.Number <> 0 Then
         Err.Clear
     Else
         CT = ActiveCell.Top
         CL = ActiveCell.Left
         CH = ActiveCell.Height
         CW = ActiveCell.Width
        
         ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & "\pic\" & FileName).Select
         With Selection
             .Placement = xlMoveAndSize '设置图片格式为跟随单元格大小变化。
            .ShapeRange.LockAspectRatio = msoFalse '设置图片格式为高宽不按比例变化。
            .Top = CT
             .Left = CL
             .Height = CH
             .Width = CW
         End With
     End If
End Sub

szaf22222

有高手在吗