[以解決] 在2010不能使用, 在2003使用正常,希望各位高人幫忙修改

joyark

在2010不能使用,希望各位高人幫忙修改
在2003使用正常的資料如下
第一,表格
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Cells(1)
    If (.Column = 3 Or .Column = 7 Or .Column = 11 Or .Column = 15) And .Row Mod 4 = 2 Then
        addPic Target.Cells(1)
    End If
End With
End Sub
改了這部份1
Sub fdjpg(nm As String)
With Application.FileSearch
    .LookIn = ThisWorkbook.Path
    .SearchSubFolders = True
    .Filename = nm & ".jpg"
    If .Execute <> 0 Then
        nm = .FoundFiles(1)
    Else
        nm = ""
    End If
End With
第二,是宏
Sub addPic(tgRng As Range)    '表格
    Dim rng As Range
    Dim nm As String
    Dim shp As Shape
    With tgRng
        nm = .Text
        Selection.Cut
        Set rng = .Offset(1, 0).Resize(1, 1)    '地址
    End With改了這部份2
    fdjpg nm
    If nm <> "" Then
        rng.Worksheet.Pictures.Insert(nm).Select
        With Selection
            .Top = rng.Top + 1
            .Left = rng.Left + 1
            .Placement = xlMoveAndSize
            .Width = rng.Width - 1
            .Height = rng.Height - 1
        End With
    Else
       ' MsgBox nm & "沒有圖片"
    End If
End Sub更改了這部份1
Dim fpath
Sub fdjpg(myfolder, myfile)
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder(myfolder)
For Each f In ff.Files
    If f.Name = myfile Then fpath = f: Exit Sub
Next
For Each fd In ff.subfolders
    fdjpg fd, myfile
Next
End Sub
更改了這部份2
addpic中
fdjpg thisworkbook.path,nm & ".jpg"
if fpath<>"" then
rng.Worksheet.Pictures.Insert(fpath).Select

ganlinlao

FileSearch方法已取消
用dir或别的替代