Excel精英培训网

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

[已解决]【VBA】人事表里关联调取文件夹中对应图片

[复制链接]
发表于 2012-3-19 15:27 | 显示全部楼层 |阅读模式
本帖最后由 yangkd 于 2012-3-20 15:46 编辑

各位朋友,请浏览后百忙中给予帮忙,谢谢。
恳请老师能看看啊:
zjdh.jpg x.jpg
姓名---图片显示---三处【本人】+【身份证正反面】,
目前当两个文件夹都有姓名对应的字段图片能满足要求,
当其中至少一个文件夹没有姓名对应字段的图片就失败了。

【特记】一对多的图片引用,缺失时用特定图片来填补。
入职与照片对应.jpg
入职图片说明.jpg
人事入职表对应图片.tar (561 KB, 下载次数: 112)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2012-3-19 15:27 | 显示全部楼层
上面部分符合要求的代码来自蓝桥玄霜老师为别人解答问题的代码,我不懂代码改动的不对。
没有完全实现我的愿望,请各位老师帮忙为谢!
回复

使用道具 举报

发表于 2012-3-20 17:50 | 显示全部楼层    本楼为最佳答案   
本帖最后由 zjdh 于 2012-3-20 18:03 编辑

  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim shp As Shape
  3.     Dim n As Long
  4.     If Target.Address = "$B$4" Then
  5.         ActiveSheet.Pictures.Delete
  6.         PC = Dir(ThisWorkbook.Path & "\图片" & Target.Text & ".jpg")
  7.         If Not PC = "" Then
  8.             Sheet83.Shapes.AddPicture ThisWorkbook.Path & "\图片" & Target.Text & ".jpg", msoFalse, msoTrue, Range("n18").Left, Range("n18").Top, Range("n18:t26").Width, Range("n18:t26").Height
  9.         Else
  10.             Sheet83.Shapes.AddPicture ThisWorkbook.Path & "\图片\没有图片.jpg", msoFalse, msoTrue, Range("n18").Left, Range("n18").Top, Range("n18:t26").Width, Range("n18:t26").Height
  11.         End If
  12.         PC = Dir(ThisWorkbook.Path & "\身份证" & Target.Text & "-正.jpg")
  13.         If Not PC = "" Then
  14.             Sheet83.Shapes.AddPicture ThisWorkbook.Path & "\身份证" & Target.Text & "-正.jpg", msoFalse, msoTrue, Range("a19").Left, Range("f19").Top, Range("a19:f19").Width, Range("a19:f28").Height
  15.         Else
  16.             Sheet83.Shapes.AddPicture ThisWorkbook.Path & "\身份证\没有图片-正.jpg", msoFalse, msoTrue, Range("a19").Left, Range("f19").Top, Range("a19:f19").Width, Range("a19:f28").Height
  17.         End If
  18.         PC = Dir(ThisWorkbook.Path & "\身份证" & Target.Text & "-反.jpg")
  19.         If Not PC = "" Then
  20.             Sheet83.Shapes.AddPicture ThisWorkbook.Path & "\身份证" & Target.Text & "-反.jpg", msoFalse, msoTrue, Range("a29").Left, Range("f29").Top, Range("a29:f29").Width, Range("a29:f38").Height
  21.         Else
  22.             Sheet83.Shapes.AddPicture ThisWorkbook.Path & "\身份证\没有图片-反.jpg", msoFalse, msoTrue, Range("a29").Left, Range("f29").Top, Range("a29:f29").Width, Range("a29:f38").Height
  23.         End If
  24.     End If
  25.     Exit Sub
  26. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2012-3-20 18:01 | 显示全部楼层
zjdh 发表于 2012-3-20 17:50

zjdh大师,谢谢啦!效果很好,特满意。
老师,多次帮忙解决问题,谢谢!每一次解答都有惊喜。
祝老师全家安康,完事圆满!

回复

使用道具 举报

发表于 2012-3-20 18:05 | 显示全部楼层
本帖最后由 zjdh 于 2012-3-20 18:08 编辑

不客气!
以下语句
For Each shp In Shapes
  shp.Delete
Next

应改为
ActiveSheet.Pictures.Delete
更合理
回复

使用道具 举报

 楼主| 发表于 2012-3-20 18:21 | 显示全部楼层
zjdh 发表于 2012-3-20 18:05
不客气!
以下语句
For Each shp In Shapes

好的,虽然我不懂得原理,我试试效果能感觉的来。谢谢!
回复

使用道具 举报

 楼主| 发表于 2012-3-20 19:10 | 显示全部楼层
yangkd 发表于 2012-3-20 18:01
zjdh大师,谢谢啦!效果很好,特满意。
老师,多次帮忙解决问题,谢谢!每一次解答都有惊喜。
祝老师全 ...

老师,我刚刚试了出来一个奇怪的现象:
1.开始在桌面试试完全可行---因为只试了本人提供的四个名字,
   而且表里姓名还存在有效性(后来删除了姓名有效性),我试
   图剪切到我的文档里也没有问题;
2.我再次剪切到桌面上运行时,出现了问题:当姓名不能对应
   “图片”文件夹中对应姓名字段时,图片没有反映了,不能对应
   显示“没有图片”的那个图片,即使“身份证”文件夹里有对应的字段。
    比如:姓名
    输入“杨珂”时,图片为空白。
3.把文件和图片文件夹放到我的文档里还是可以的。
请老师看看是否有这样的问题,麻烦了。
人事入职表对应图片.gif

回复

使用道具 举报

发表于 2012-3-21 08:01 | 显示全部楼层
你看一下“图片”目录下有没有“没有图片.jpg“ 这个文件,
你原来附件中没此文件!

评分

参与人数 1 +3 收起 理由
yangkd + 3 很给力!老师是大师级的益友,热情,有学识,.

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2012-3-21 08:16 | 显示全部楼层
zjdh 发表于 2012-3-21 08:01
你看一下“图片”目录下有没有“没有图片.jpg“ 这个文件,
你原来附件中没此文件!

太不好意思了,我怎么说好奇怪了。
1.我的文档里“图片”文件夹有“没有图片”那个图片,我桌面的没有;
2.原理这么简单,我居然如此的笨拙,不懂VBA害苦别人和自己了。
老师,谢谢你!!你真的看的好仔细,一语中的啊,高深!!
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 02:25 , Processed in 0.865519 second(s), 17 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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