将多套图片批量分别插入对应的word中

Posted 2023-04-13

我想批量做100个word文件，已经有了固定的格式，就是一个word格式的模板，只要把相应的图片插入到相应的表格里就行，图片也有固定的名称，多谢多谢！！！
像这样的格式

打开word
插入——图片——来自文件

选定所有需要的插入后
用回车键在各图片间建立空行

新建一个空白的word文档。
工具——》宏——》vb编辑器——》打开this document ——》把下面代码粘入编辑窗口——》保存

打开这个word文档——》工具——》宏——》执行 下面的不用我说了，最后记得通配符批量替换照片就可以一行显示多张了。

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追问

看不太懂，我用的是2013的word,

参考技术A 回答

具体操作步骤如下：一、首先在存储图片的文件中调整好图片的顺序，然后选中全部图片拖入Word。二、选中第一张图并调整图片到合适大小。三、点击上方任务栏中的图片工具->格式，找到调整好的图片的高度，Ctrl+C复制。四、接下来调整其他图片一样。选中需要调整的图，然后按F4，即可完成寸修改。五、将调整好尺寸的图按照以下形式排布，光标放在在第二张图前面然后回车，光标放在在第三张图前面然后回车，光标放在在第四张图前面然后回车。六、同时按住Ctrl+A完成对图片的全选，然后点击上方任务栏中文本转换成表格，弹出来的对话中选择确定。七、生成填充了图片的表格之后，选中整个表格内容，同时按住Ctrl+C，然后选中需要插入图片的表格，同时按住Ctrl+V，即可实现批量向word中的表格添加图片。

Word批量调整插入图片大小

做标书，word中需要插入大量图片，实为一些证书、文件的扫描文件。但插入后，大小不是想要的，太小了，打印出来看不清。需要调整，需要批量调整。

这是一个不错的方法：

选中第一张图片，按页面调整大小到适合的位置；

选中第二张，F9；

选中第三张，F9；

……

选中第N张，F9；