Excel精英培训网

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

[已解决]根据数据在特定位置自动引用制定文件夹内的图片

[复制链接]
发表于 2012-12-5 09:14 | 显示全部楼层 |阅读模式
各位高手,这样我现在做一个准考证打印的数据表,表一是录入的准考证数据,表二是准考证模板,我需要实现的功能是点选表一的某一行,自动将数据填充到表二,同时也将照片自动引用到表二的指定位置,现在我已经实现了数据的正常引用,可是照片始终引用不进去,看看能不能用VBA给解决下!
最佳答案
2012-12-5 14:01
本帖最后由 hwc2ycy 于 2012-12-5 16:19 编辑

(, 下载次数: 34)

准考证.rar

161.35 KB, 下载次数: 33

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2012-12-5 09:27 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2012-12-5 09:48 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2012-12-5 10:05 | 显示全部楼层
小弟跪谢了 大神们
回复

使用道具 举报

 楼主| 发表于 2012-12-5 10:40 | 显示全部楼层
小弟跪谢了 大神们
回复

使用道具 举报

发表于 2012-12-5 10:55 | 显示全部楼层
准考证打印.rar (12.45 KB, 下载次数: 59)
回复

使用道具 举报

发表于 2012-12-5 10:58 | 显示全部楼层
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim Path$, filename$
  3.     On Error Resume Next
  4.     If Targetrow < 5000 And Target.Column < 2 Then
  5.         Range("T2") = Cells(Target.Row, Target.Column)
  6.     End If
  7.     Worksheets("准考证").DrawingObjects.Delete
  8.    
  9.     Path = ThisWorkbook.Path & "\pic" & [t2] & ".jpg"
  10.     filename = Dir(Path, vbNormal + vbDirectory + vbHidden + vbReadOnly + vbSystem)
  11.     If Len(filename) > 0 Then
  12.         With Worksheets("准考证")
  13.            With .Pictures.Insert(Path)
  14.                .ShapeRange.Left = 363
  15.                .ShapeRange.Top = 90
  16.            End With
  17.            With .Pictures.Insert(Path)
  18.                .ShapeRange.Left = 363
  19.                .ShapeRange.Top = 473
  20.            End With
  21.        End With
  22.     End If
  23. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2012-12-5 11:19 | 显示全部楼层
hwc2ycy 发表于 2012-12-5 10:58

十分感谢 这样在修改表一的数据时会弹出错误怎么处理呀
回复

使用道具 举报

 楼主| 发表于 2012-12-5 11:43 | 显示全部楼层
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo err
    Dim Path$
    If Target.Row < 5000 And Target.Column < 2 Then
        Range("T2") = Cells(Target.Row, Target.Column)
    End If
    Worksheets("准考证").DrawingObjects.Delete
    Path = ThisWorkbook.Path & "\pic\" & [t2] & ".jpg"
     With Worksheets("准考证")
        With .Pictures.Insert(Path)
            .ShapeRange.Left = 340
            .ShapeRange.Top = 80
            .ShapeRange.Height = 140
            .ShapeRange.Width = 110
        End With
        With .Pictures.Insert(Path)
            .ShapeRange.Left = 340
            .ShapeRange.Top = 465
            .ShapeRange.Height = 140
            .ShapeRange.Width = 110
        End With
    End With
    Exit Sub
err:     MsgBox "没有数据"
End Sub
回复

使用道具 举报

 楼主| 发表于 2012-12-5 11:44 | 显示全部楼层
hwc2ycy 发表于 2012-12-5 10:58

在第一个表里面输入的时候总是提示错误 有没有办法解决啊 谢谢大神
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 15:10 , Processed in 0.768706 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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