在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 时间: 2017-5-16 19:29
FileSearch方法已取消
用dir或别的替代