WordVBA-批量整页插入非嵌入式图片-分析和解决问题全流程
rem 本视频代码（路径在您的电脑上，需要根据自己的实际情况改一下）：
Sub 形状插入()
Dim sp As Shape
Set sp = ActiveDocument.Shapes.AddPicture("E:\资料\学习\答疑\VBA\20230414批量插入图片\图片\01.jpg", Anchor:=ActiveDocument.Paragraphs.Last.Range)
With sp
.WrapFormat.Type = wdWrapBehind
.LockAspectRatio = True
If .Width / .Height >= .Anchor.Sections.First.PageSetup.PageWidth / .Anchor.Sections.First.PageSetup.PageHeight Then
'图片宽高比大于等于图片所在的页面宽高比时：
.Height = .Anchor.Sections.First.PageSetup.PageHeight
Else
.Width = .Anchor.Sections.First.PageSetup.PageWidth
End If
'设置水平和垂直对齐方式：相对于页面居中
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = WdShapePosition.wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeCenter
End With
End Sub
'***在Word VBA中：形状不能转图片，图片可以转形状
Sub 图片插入()
Dim isp1 As InlineShape
Set isp1 = ActiveDocument.InlineShapes.AddPicture("E:\资料\学习\答疑\VBA\20230414批量插入图片\图片\01.jpg", Range:=Selection.Range)
Dim sp As Shape
Set sp = isp1.ConvertToShape
With sp
.WrapFormat.Type = wdWrapBehind
.LockAspectRatio = True
If .Width / .Height >= .Anchor.Sections.First.PageSetup.PageWidth / .Anchor.Sections.First.PageSetup.PageHeight Then
'图片宽高比大于等于图片所在的页面宽高比时：
.Height = .Anchor.Sections.First.PageSetup.PageHeight
Else
.Width = .Anchor.Sections.First.PageSetup.PageWidth
End If
'设置水平和垂直对齐方式：相对于页面居中
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = WdShapePosition.wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeCenter
End With
End Sub
Sub 批量插入图片()
Dim fd As FileDialog
Dim s As String
Dim f As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.InitialFileName = ActiveDocument.Path
If .Show Then
s = Dir(.SelectedItems(1) & "\", vbNormal)
Do While s <> ""
f = .SelectedItems(1) & "\" & s
f = LCase(f)
Debug.Print f
'如果限定处理.jpg和.png文件
Dim s1 As String
s1 = Split(f, ".")(UBound(Split(f, ".")))
If s1 = "jpg" Or s1 = "png" Then
Dim sp As Shape
Set sp = ActiveDocument.Shapes.AddPicture(f, Anchor:=ActiveDocument.Paragraphs.Last.Range)
With sp
.WrapFormat.Type = wdWrapBehind
.LockAspectRatio = True
If .Width / .Height >= .Anchor.Sections.First.PageSetup.PageWidth / .Anchor.Sections.First.PageSetup.PageHeight Then
'图片宽高比大于等于图片所在的页面宽高比时：
.Height = .Anchor.Sections.First.PageSetup.PageHeight
Else
.Width = .Anchor.Sections.First.PageSetup.PageWidth
End If
'设置水平和垂直对齐方式：相对于页面居中
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Left = WdShapePosition.wdShapeCenter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeCenter
End With
ActiveDocument.Range.InsertParagraphAfter
ActiveDocument.Range.Paragraphs.Last.Range.InsertBreak WdBreakType.wdPageBreak
End If
s = Dir
Loop
End If
End With
End Sub
