请大神看看批量插图的代码！

liutao1987314

   这是我弄的批量插图的代码，之前03版本可以用图也是可以插进去的，但是后来用料10之后发现插进去的都是连接（我把存图的文件文件移到其他位置后就无法显示），请大神帮忙看看问题在哪里？

Sub insert_picture()
ER = [b65536].End(xlUp).Row
Dim i
i = 0
Application.Calculation = xlCalculationManual
    On Error Resume Next
    Dim stMedd As String

  Do
   stMedd = "Folder"
    Set obMapp = CreateObject("Shell.Application").BrowseForFolder(0, stMedd, &H1)
    If Not obMapp Is Nothing Then
       Directory = obMapp.self.Path & "\"
       Response1 = MsgBox("Are you fully confident this path: " & Directory, vbYesNo, "Message_lilium_li:")
       If Response1 = vbYes Then Exit Do
       Else: End
    End If
  Loop
    Load frmMain
    frmMain.Show
Application.Calculation = xlCalculationAutomatic
Set FS = CreateObject("Scripting.FileSystemObject")
      Set F = FS.GetFolder(Directory)
      Set FC = F.Files
        For Each f1 In F.Files
           Fig = Left(f1.Name, Len(f1.Name) - 4)
              For Each C In Range("B29:J" & ER)
                 If C = "insert wavefom here" And C.Offset(-2, 0) = Fig Then
                      C.Select
                      Filpath = Directory & C.Offset(-2, 0).Text & ".jpg"
                      Inserpic (Filpath)
                      i = i + 1
                 ElseIf C = "insert wavefom here" And C.Offset(-3, 0) = Fig Then
                       C.Select
                       Filpath = Directory & C.Offset(-3, 0).Text & ".jpg"
                       Inserpic (Filpath)
                       i = i + 1
                Else
                End If
              Next C
       Next
MSG = "To accomplish,&the sum of the pictures have been inserted is " & i
a = MsgBox(MSG, vbInformation, "Message_lilium_li:")
End Sub

Sub Inserpic(g)
  Taddress = Selection.Address
      ActiveSheet.Pictures.Insert(g).Select
      Selection.ShapeRange.LockAspectRatio = msoFalse
      Selection.Top = Range(Taddress).Top
      Selection.Left = Range(Taddress).Left
      Selection.Width = Range(Taddress).Width
            Selection.Height = Range(Taddress).Height
End Sub