Мой макрос в настоящее время выполняет следующие действия:
Добавляет заголовок к документу Word, затем считывает файлы изображений из определенной папки с жесткого диска и добавляет их в тот же документ с именем файла под изображением и разрывом страницы после каждого изображения. Чтобы гарантировать, что имя не будет перемещено на следующую страницу (если изображение заполняет всю страницу), я устанавливаю нижнее поле на более высокое значение перед добавлением изображения и имени, а затем устанавливаю поле обратно к исходному значению. , Таким образом, изображение становится немного меньше и оставляет достаточно места для имени.
Что я сейчас хочу добавить к этому:
Переключите ориентацию страницы в зависимости от ширины и высоты изображений и добавьте разрыв страницы вручную, чтобы в одном документе можно было иметь несколько ориентаций.
Но я уже ошибаюсь в первую очередь:
- Как узнать ширину / высоту / соотношение изображений перед их добавлением
к документу (
Img.Width не существует в Word)? Мне все равно, что это за информация, если она говорит мне, является ли изображение пейзажным или портретным.
- Как добавить разрыв страницы вручную (
Chr(12) просто переходит на следующую страницу без добавления фактического разрыва)?
- Добавление разрыва страницы вручную также означает, что текст моего заголовка впоследствии не будет использоваться, но как мне установить его для нового «Раздела»? Я предполагаю, что это не все еще
ActiveDocument.Sections(1) тогда, это?
Мой код (только Sub импорта изображений):
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 vertical As Boolean
Set fs = CreateObject("Scripting.FileSystemObject")
Set ff = fs.GetFolder(path).Files
i = 0
fsize = ff.Count
vertical = True
With ActiveDocument
bottomMarginOriginal = .PageSetup.BottomMargin
.PageSetup.BottomMargin = bottomMarginOriginal + Application.CentimetersToPoints(1) 'Add 1cm to margin
For Each Img In ff
Select Case Right(Img.name, 4)
Case ".bmp", ".jpg", ".gif", ".png", "tiff", ".tif"
If i <> 0 Then
.Characters.Last.InsertBefore Chr(12) 'Add page break before adding the img
Debug.Print "Width: " & Img.Width 'Error message: Doesn't exist!
Else
.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "test text"
.PageSetup.Orientation = wdOrientLandscape 'TODO: Check the img ratio
vertical = False
End If
i = i + 1
.Characters.Last.InlineShapes.AddPicture filename:=Img 'Add the img
.Characters.Last.InsertBefore Chr(11) & Img.name 'Add a line break and the img name
End Select
Next
End With
ActiveDocument.PageSetup.BottomMargin = bottomMarginOriginal
End Sub
Редактировать:
Этот код добавляет разрывы разделов, но, похоже, он устанавливает ориентацию для всего документа, а не только для текущего раздела, поэтому я получаю одинаковую ориентацию на всех страницах, плюс изображения добавляются только в самом последнем раздел без каких-либо страниц / разделов между ними. Как мне это исправить?
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