ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[分享] 批量插入图片

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2015-9-28 10:59 | 显示全部楼层
想找excel批量插入的,这个word的也很方便,收藏了

TA的精华主题

TA的得分主题

发表于 2015-9-29 08:22 | 显示全部楼层
受教了,这个不错啊!赞

TA的精华主题

TA的得分主题

发表于 2015-10-7 09:06 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2015-10-13 17:05 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2015-12-28 22:39 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
我是新手,有两个问题请教,请不要见笑:
1、Sub setpicsize()
'
' setpicsize 宏
'
'
Dim iSha As InlineShape
For Each iSha In ActiveDocument.InlineShapes
If iSha.Type = wdInlineShapePicture Then
    iSha.LockAspectRatio = msoFalse    '不锁定纵横比
      iSha.Width = CentimetersToPoints(9#)  '宽5CM
        iSha.Height = CentimetersToPoints(9.2) '高5CM
          End If
          Next

End Sub
这个代码只能对嵌入格式的照片进行操作,其他格式的如"衬于文字下方"就没操作,有没有对为种格式操作的方法。
2、想将4张照片复制到文档后,运行代码就能上下两排,排列整齐。请帮忙写下代码。谢谢!

TA的精华主题

TA的得分主题

发表于 2015-12-28 22:41 | 显示全部楼层
补充一下,每张照片大小高:6.8CM、宽:10CM;页面是横向的。谢谢!

TA的精华主题

TA的得分主题

发表于 2017-7-7 09:45 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
鼠标点选文件夹才比较方便

批量插入图片

批量插入图片

TA的精华主题

TA的得分主题

发表于 2018-5-28 23:38 | 显示全部楼层
如何自定义设置图片的大小尺寸?

TA的精华主题

TA的得分主题

发表于 2018-5-29 21:36 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
如何自定义设置图片的大小尺寸?

TA的精华主题

TA的得分主题

发表于 2020-10-30 14:19 | 显示全部楼层
tangqingfu 发表于 2011-12-6 08:35
能否将文件夹的地址改为可选取,而非输入的方式?
  1. Sub 图片批插() Rem ************************************************************ Rem 作 者: 张斌 Rem 功 能: 将扫描业绩图片文件批量插入word文件中 Rem 备 注: 需要改进 Rem 反馈邮箱:gogozb@163.com Rem 业务联系QQ:1065886598 Rem 帖子:http://club.excelhome.net/forum.php?mod=guide&view=my Rem ************************************************************ Rem VBA知识点: Application.ScreenUpdating = False Dim ph$, d As Object, d1 As Object With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then ph = .SelectedItems(1) Else Exit Sub End If End With ThisDocument.Content.Delete With CreateObject("scripting.filesystemobject") Fn = .GetFileName(ph) With Application.Selection .InsertAfter Fn .Style = ActiveDocument.Styles("标题 1") .EndKey Unit:=wdStory '光标定位至文末 .TypeParagraph '插入一个新的空段落 End With For Each d In .getfolder(ph).subfolders Fs = .GetFileName(d) With Application.Selection .InsertAfter Fs .Style = ActiveDocument.Styles("标题 2") .EndKey Unit:=wdStory '光标定位至文末 .TypeParagraph '插入一个新的空段落 End With For Each d1 In d.Files If .GetExtensionName(d1) = "JPG" Or .GetExtensionName(d1) = "png" Or .GetExtensionName(d1) = "jpg" Or .GetExtensionName(d1) = "bmp" Then With Application.Selection .EndKey Unit:=wdStory '光标定位至文末 .InlineShapes.AddPicture FileName:=d1.Path .Style = ActiveDocument.Styles("正文") End With End If Next d1 Selection.TypeParagraph Next d End With Application.ScreenUpdating = True MsgBox "插入完毕!", 48, "提示!" End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-7-12 17:52 , Processed in 0.033696 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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