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页
- 相关文章
- ·少点鼠标,让手轻松一些10-29·免魔法使用 New Bing 新方案03-18·我的电脑图标不见了,怎么找回来! 09-14·Excel输入分数的七种方法06-05·让Windows XP自动登录的三种方法 09-14·磁带转录成MP3操作方法 09-23·安卓手机因软件安装失败解决方法06-19·WORD在所有数字前加回车12-10·windows 2008 R2各版本激活180天05-03·EXCEL表格如何删除零值03-29
- 最新文章
- ·视频号视频的四种下载方法07-07·Win10系统开机启动文件夹在哪里?04-16·十秒免工具激活windows 1002-25·批量替换word文档中的第一行作为文件的文件名06-21·连接打印机时需要输入用户名密码怎么办?05-15·免魔法使用 New Bing 新方案03-18·Win10电脑账号密码设置、修改、取消12-06
- 阅读排行
- ·如何让试题的ABCD选项对齐04-13·word排版技巧整理08-02·word 如何自动生成目录08-02·Excel 进行学生成绩统计分析03-13·不同电脑文件字体改变了的解决方法12-15·我的电脑图标不见了,怎么找回来! 09-14·Win10电脑的一些安装提示12-03·Word高级替换技巧03-05·Excel如何批量插入分页符02-12·巧用Excel数组公式统计各班优秀人数04-24
2008-2021www.zshunj.cn
点击这里识别二维码关注公众号
点击这里识别二维码关注公众号