WORD批量插入图片和文件名
来源:网络整理
发布时间:2019-11-12 10:42:00
查看次数:
内容提要:因为需要,找了两个VBA代码。
另一个
Sub InsertPic()
Dim myfile As FileDialog
Set myfile = Application.FileDialog(msoFileDialogFilePicker)
With myfile
.InitialFileName = "F:"
If .Show = -1 Then
For Each fn In .SelectedItems
Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True)
'按比例调整相片尺寸
WidthNum = mypic.Width
c = 10 '在此处修改相片宽,单位厘米
mypic.Width = c * 28.35
mypic.Height = (c * 28.35 / WidthNum) * mypic.Height
If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Selection.Text = Basename(fn) '函数取得文件名
Selection.EndKey
If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Next fn
Else
End If
End With
Set myfile = Nothing
End Sub
Function Basename(FullPath) '取得文件名
Dim x, y
Dim tmpstring
tmpstring = FullPath
x = Len(FullPath)
For y = x To 1 Step -1
If Mid(FullPath, y, 1) = "" Or _
Mid(FullPath, y, 1) = ":" Or _
Mid(FullPath, y, 1) = "/" Then
tmpstring = Mid(FullPath, y + 1)
Exit For
End If
Next
Basename = Left(tmpstring, Len(tmpstring) - 4)
End Function
第1页 第2页
- 相关文章
- ·excel删除数字保留文本02-04·win8 iis8.0 安装获取方法01-22·删除 word 中所有的中文字符03-17·用vlookup从右向左查询(逆向查询)吗?01-20·如何在excel中统计各分数段人数?03-12·如何让试题的ABCD选项对齐04-13·自动双面打印操作说明10-14·隐藏Excel错误结果显示的三种方法10-12·excel如何取两个特定字符间的文字03-04·如何在EXCEL中添加中文语音朗读功能07-21
- 最新文章
- ·一列数据轻松转换成多行多列02-05·MPC-HC如何加速播放不变音调?01-06·利用打印机迁移功能实现三个步骤快速批量安装所有网10-27·视频号视频的四种下载方法07-07·Win10系统开机启动文件夹在哪里?04-16·十秒免工具激活windows 1002-25·批量替换word文档中的第一行作为文件的文件名06-21·连接打印机时需要输入用户名密码怎么办?05-15
- 阅读排行
- ·如何让试题的ABCD选项对齐04-13·word排版技巧整理08-02·word 如何自动生成目录08-02·Excel 进行学生成绩统计分析03-13·Win10电脑的一些安装提示12-03·我的电脑图标不见了,怎么找回来!09-14·不同电脑文件字体改变了的解决方法12-15·Word高级替换技巧03-05·巧妙管理 为打印机减负05-25·巧用Excel数组公式统计各班优秀人数04-24
2008-2021www.zshunj.cn
点击这里识别二维码关注公众号
点击这里识别二维码关注公众号