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页
- 相关文章
- ·开机提示ntldr is missing解决方法08-13·乱序分班输入成绩简便方法说明05-11·办公室局域网打印机共享轻松设置09-22·轻松解决“找不到macro1$A$2”02-18·微信公众号音频音乐提取方法10-19·WORD在所有数字前加回车12-10·隐藏Excel错误结果显示的三种方法10-12·相片裁剪操作方法10-21·115网盘多人使用防踢软件10-23
- 最新文章
- ·Win10系统开机启动文件夹在哪里?04-16·十秒免工具激活windows 1002-25·批量替换word文档中的第一行作为文件的文件名06-21·连接打印机时需要输入用户名密码怎么办?05-15·免魔法使用 New Bing 新方案03-18·Win10电脑账号密码设置、修改、取消12-06·[亲测有效]excel批量修改文件名10-29
- 阅读排行
- ·如何让试题的ABCD选项对齐04-13·word排版技巧整理08-02·word 如何自动生成目录08-02·不同电脑文件字体改变了的解决方法12-15·Excel 进行学生成绩统计分析03-13·我的电脑图标不见了,怎么找回来!09-14·Win10电脑的一些安装提示12-03·Word高级替换技巧03-05·Excel如何批量插入分页符02-12·制作Word2003选择性粘贴快捷键07-09
2008-2021www.zshunj.cn
点击这里识别二维码关注公众号
点击这里识别二维码关注公众号