ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1064|回复: 6

循环添加照片打印

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-2-17 16:58 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
需要制作一个档案,自动填写每户信息及添加照片打印。现填写信息已经编辑完成,添加照片功能看了很多代码都不行,希望大家能帮我看看!如果能增加打印的表格全部合并在一个pdf中更好!谢谢!图片名要按照工作表1当中最后一列的内容来查找添加!图片需要自动按照设置的单元格大小按原照片比例缩放(有的照片是竖着照的),

20200217农村户厕档案套打求助.zip

130 KB, 下载次数: 13

TA的精华主题

TA的得分主题

发表于 2020-2-17 19:05 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
http://club.excelhome.net/thread-1441877-1-1.html
楼主参考下这个帖子看看吧

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-17 19:07 | 显示全部楼层
liulang0808 发表于 2020-2-17 19:05
http://club.excelhome.net/thread-1441877-1-1.html
楼主参考下这个帖子看看吧

好的,谢谢

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-18 10:42 | 显示全部楼层
Sub 图片导入()
'将图片导入。
'图片按照原比例存储,按照原比例存储
Dim myShape As Shape, target As Range

On Error Resume Next
Sheets("农村户厕改建情况表(到户)").Shapes("myShape").Delete
cPath = ThisWorkbook.Path
With ActiveSheet
    .Pictures.Insert(cPath & Sheets("农村户厕汇总数据").Range("v" & i) & ".jpg").Select
    Set target = .Cells(10, 2)
    With Selection
        .Top = target.Top + 1
        .Left = target.Left + 1
        .Width = target.Width - 1
        .Height target.Height - 1
        End With
    End With
End Sub

        
        参照《excel vba实战技巧精粹》写了这段代码,运行没有出错,但是图片还是没有插入成功!请各位帮忙看下哪错了 image.png

TA的精华主题

TA的得分主题

发表于 2020-2-18 12:37 | 显示全部楼层
Sub 图片导入()
    Dim sp As Shape '定义sp为对象
    Dim rng As Range
    For Each sp In Sheets("农村户厕改建情况表(到户)").Shapes '遍历工作表中的图片
      If sp.Type <> 8 Then sp.Delete '删除图片
    Next sp
    Tel = Sheets("农村户厕汇总数据").Range("g3").Value '电话(注:图片命名中,必包含电话号码)
    Myname = Dir(ThisWorkbook.Path & "\*" & Tel & "*.jp*g") '图片名
     pah = ThisWorkbook.Path & "\" & Myname  '图片路径及图片名
     Set rng = Sheets("农村户厕改建情况表(到户)").Range("B10:F10") '需要插入图片的单元格区域
     Sheets("农村户厕改建情况表(到户)").Shapes.AddPicture pah, True, True, rng.Left, rng.Top, rng.Width, rng.Height '添加图片,充满单元格区域
End Sub

TA的精华主题

TA的得分主题

发表于 2020-2-18 12:40 | 显示全部楼层
本帖最后由 网海遨游 于 2020-2-18 12:42 编辑

代码在审核,上个图片
image.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-19 11:24 | 显示全部楼层
网海遨游 发表于 2020-2-18 12:40
代码在审核,上个图片

感谢您的帮助!我用了你的代码 把参数改了一下……终于可以了   
Sub 图片导入()
    Dim sp As Shape '定义sp为对象
    Dim rng As Range
    Dim Tel As String
    Dim Myname As String
    On Error Resume Next
    i = Range("j6")
    For Each sp In Sheets("农村户厕改建情况表(到户)").Shapes '遍历工作表中的图片
        If sp.Type = 13 Then
            sp.Delete '删除图片
        End If
    Next sp
    Tel = Sheets("农村户厕汇总数据").Range("h" & i).Value '电话(注:图片命名中,必包含电话号码)
    Myname = Sheets("农村户厕汇总数据").Range("y" & i) & ".jpg"
    'Myname = Dir(ThisWorkbook.Path & "\*" & Tel & "*.jp*g") '图片名
    pah = ThisWorkbook.Path & "\" & Myname  '图片路径及图片名
    Set rng = Sheets("农村户厕改建情况表(到户)").Range("B10:F10") '需要插入图片的单元格区域
    Set sp = Sheets("农村户厕改建情况表(到户)").Shapes.AddPicture(pah, True, True, rng.Left, rng.Top, rng.Width, rng.Height) '添加图片,充满单元格区域
   
    If Myname = "" Then
        MsgBox "找不到对应图片"
    End If
   
   
End Sub
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 22:06 , Processed in 0.049339 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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