这个问题是关于一个新的问题，当我试图获得一些工作的东西，我已经问了一个question。
我希望我的宏做什么/它已经做了什么：
为了确保名称不会被推到下一页（如果图像填满整个页面），我在添加图像和名称之前将底部边距设置为更高的值，然后将边距设置回原始值。这样，图像稍微小一点，并为名称留下足够的空间。
我的代码（见下文）确实添加了分节符，但它似乎设置了整个文档的方向，而不仅仅是当前节，所以我最终在所有页面上都有相同的方向。图像也仅在最后一部分中添加，两者之间没有任何页面/部分中断。
我该如何解决？
在另一个问题中，有人已经发布了完整的代码来设置方向，但我更愿意理解为什么我的代码无法正常复制其他人完全不同的代码。
我的代码：
Sub ImportImages(path As String)
Dim fs As Object
Dim ff As Variant
Dim img As Variant
Dim i As Long
Dim fsize As Long
Dim bottomMarginOriginal As Single
Dim topMarginOriginal As Single
Dim vertical As Boolean
Dim objShell As New Shell
Dim objFolder As Folder
Dim objFile As ShellFolderItem
Dim width As Integer
Dim height As Integer
Set fs = CreateObject("Scripting.FileSystemObject")
Set ff = fs.GetFolder(path).Files
i = 0
fsize = ff.Count
vertical = True
Set objFolder = objShell.NameSpace(path)
With ActiveDocument
bottomMarginOriginal = .PageSetup.BottomMargin
topMarginOriginal = .PageSetup.TopMargin
For Each img In ff
Select Case Right(img.name, 4)
Case ".bmp", ".jpg", ".gif", ".png", "tiff", ".tif"
Set objFile = objFolder.ParseName(img.name)
width = objFile.ExtendedProperty("{6444048F-4C8B-11D1-8B70-080036B11A03} 3")
height = objFile.ExtendedProperty("{6444048F-4C8B-11D1-8B70-080036B11A03} 4")
If width > height Then
If vertical = False Then 'Already landscape -> just add page break
.Characters.Last.InsertBefore Chr(12)
Else 'Set to landscape
Selection.InsertBreak Type:=wdSectionBreakNextPage
.PageSetup.Orientation = wdOrientLandscape
.PageSetup.TopMargin = topMarginOriginal 'Adjust margins to new orientation
.PageSetup.RightMargin = bottomMarginOriginal
.PageSetup.BottomMargin = bottomMarginOriginal
.PageSetup.LeftMargin = bottomMarginOriginal
.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "test " & i 'Set header
vertical = False
End If
ElseIf height > width Then
If vertical = True Then 'Already portrait -> just add page break on page 2+
If i <> 0 Then
.Characters.Last.InsertBefore Chr(12)
End If
Else 'Set to portrait
Selection.InsertBreak Type:=wdSectionBreakNextPage
.PageSetup.Orientation = wdOrientPortrait
.PageSetup.TopMargin = topMarginOriginal 'Adjust margins to new orientation
.PageSetup.RightMargin = bottomMarginOriginal
.PageSetup.BottomMargin = bottomMarginOriginal
.PageSetup.LeftMargin = bottomMarginOriginal
.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "test " & i 'Set header
vertical = True
End If
Else
If i <> 0 Then
.Characters.Last.InsertBefore Chr(12)
End If
End If
.PageSetup.BottomMargin = bottomMarginOriginal + Application.CentimetersToPoints(1) 'Add 1cm to the bottom margin
i = i + 1
.Characters.Last.InlineShapes.AddPicture filename:=img
.Characters.Last.InsertBefore Chr(11) & img.name
.PageSetup.BottomMargin = bottomMarginOriginal 'Reset bottom margin to default
End Select
Next
End With
End Sub
这是基于将图像放入表格的概念代码。我长期使用Word后获得的习惯。
目前，即使我添加了对Microsoft Shell等的引用，也无法识别ParseName关键字。
由于不需要，因此不会出现分页符。
Option Explicit
Const PortraitPictureHeight As Long = 0 ' change to cm value
Const PortraitTextHeight As Long = 0 ' change to a cm value
Const LandscapePictureHeight As Long = 0 ' change to a cm value
Const LandscapeTextHeight As Long = 0 ' change to a cm value
Const HeightOfLineAfterTable As Long = 0 ' change to a points
Sub test()
ImportImages "C:\\Users\\slayc\\Pictures"
End Sub
Sub ImportImages(path As String)
Dim fs As Scripting.FileSystemObject
Dim ff As Variant
Dim img As Variant
Dim objShell As Shell
Dim objFolder As Folder
Dim objFile As ShellFolderItem
Dim width As Long
Dim height As Long
Set fs = New Scripting.FileSystemObject
Set ff = fs.GetFolder(path).Files
Set objShell = New Shell
Set objFolder = objShell.NameSpace(path)
' The assumption is that we are adding sections to the end of the document
' so we add the Heder to the last document
' this header will be copied to each section we add to the document
' when we use Activedocument.sections.add
ActiveDocument.Sections.Last.Headers(wdHeaderFooterPrimary).Range.Text = "This is your header"
For Each img In ff
If InStr(".bmp,.jpg,.gif,.png,.tiff", Right(img.Name, 4)) = 0 Then GoTo Continue_img
Set objFile = objFolder.ParseName(img.Name)
width = objFile.ExtendedProperty("{6444048F-4C8B-11D1-8B70-080036B11A03} 3")
height = objFile.ExtendedProperty("{6444048F-4C8B-11D1-8B70-080036B11A03} 4")
' every image gets its own section with its own orientation
If width > height Then
InsertLandscapeSection
Else
InsertPortraitSection
End If
FormatLastTable
With ActiveDocument.Sections.Last.Range.Tables(1).Range
.Rows(1).Range.Cells(1).Range.Characters.Last.InlineShapes.AddPicture FileName:=img
.Rows(2).Range.Cells(1).Range.Text = img.Name
End With
Continue_img:
Next
End Sub
Public Sub InsertLandscapeSection()
Dim my_range As Word.Range
With ActiveDocument.Sections
' Deal with the case where the first section is the last section
If .Last.Range.Tables.Count > 0 Then
.Add
.Last.Range.Previous(unit:=wdParagraph).Font.Size = HeightOfLineAfterTable
End If
.Last.PageSetup.Orientation = wdOrientLandscape
With .Last
Set my_range = .Range.Duplicate
my_range.Collapse direction:=wdCollapseStart
.Range.Tables.Add my_range, 2, 1
With .Range.Tables(1).Range
.Rows.HeightRule = wdRowHeightExactly
.Rows(1).height = CentimetersToPoints(LandscapePictureHeight)
.Rows(2).height = CentimetersToPoints(LandscapeTextHeight)
End With
End With
End With
End Sub
Public Sub InsertPortraitSection()
Dim my_range As Word.Range
With ActiveDocument.Sections
If .Last.Range.Tables.Count > 0 Then
.Add
.Last.Range.Previous(unit:=wdParagraph).Font.Size = HeightOfLineAfterTable
End If
.Last.PageSetup.Orientation = wdOrientPortrait
With .Last
Set my_range = .Range.Duplicate
my_range.Collapse direction:=wdCollapseStart
.Range.Tables.Add my_range, 2, 1
With .Range.Tables(1).Range
.Rows.HeightRule = wdRowHeightExactly
.Rows(1).height = CentimetersToPoints(PortraitPictureHeight)
.Rows(2).height = CentimetersToPoints(LandscapeTextHeight)
End With
End With
End With
End Sub
Sub FormatLastTable()
With ActiveDocument.Sections.Last.Range.Tables(1)
' turn off all borders
.Borders.Enable = False
'Do any additional formatting of the table that is not related to row height
End With
End Sub