Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1281|回复: 2

(以解決)在2010出現有問題-請幫忙解決一下

[复制链接]
发表于 2017-5-16 16:42 | 显示全部楼层 |阅读模式
本帖最后由 joyark 于 2017-5-22 08:49 编辑

在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



发表于 2017-5-16 16:45 | 显示全部楼层
本帖最后由 france723 于 2017-5-16 16:50 编辑

从2007版开始, filesearch就被取消了. 使用FileSystemObject也可以. 蓝色版主写过攻略:

http://www.excelpx.com/forum.php?mod=viewthread&tid=132522&highlight=%B1%E9%C0%FA%CB%F9%D3%D0%CE%C4%BC%FE%BC%D0
回复

使用道具 举报

 楼主| 发表于 2017-5-16 18:22 | 显示全部楼层
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-5-22 21:20 , Processed in 1.354932 second(s), 6 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表