Word文書の最初の「ページ」にすべて貼り付けられたランダムな数の写真を撮り、それらを同じ文書内の複数のページに1ページあたり2枚ずつ配布したいと考えています。したがって、最初のページに 10 枚の写真がある場合、1 と 2 は最初のページに残ります。3 と 4 は 2 番目に移動されます (上に 3、下に 4)。5 と 6 は 3 ページ目に移動します。
もう少し複雑にするために、画像番号を含む文字列を各画像の下部に配置する必要があります。また、各画像は、水平/垂直、水平/水平、垂直/垂直、垂直/水平のいずれであるかに基づいて配置およびサイズ変更する必要があります。
コードを作成しましたが、追加されたブレークが思った場所に表示されません。
コードをレビューしたい人はいますか？PS私はVBAに非常に慣れていないので、あまり厳しくしないでください。ただし、建設的であることはいつでも大歓迎です。
Private Sub FormatPics()
PictCount = ActiveDocument.Shapes.Count
For PictCurrn = 1 To PictCount
' If this is an odd pictcurrn, then we're at the first
' image for the page. So get the H and V (or N) for the
' pictures that belong on the page
If (PictCurrn = 1) Or ((PictCurrn Mod 2) = 1) Then
With ActiveDocument.Shapes(PictCurrn)
Pic1L = .Left
Pic1T = .Top
Pic1W = .Width
Pic1H = .Height
If Pic1W > Pic1H Then
Pic1X = "H"
Else
Pic1X = "V"
End If
End With
If PictCurrn < PictCount Then
With ActiveDocument.Shapes(PictCurrn + 1)
Pic2L = .Left
Pic2T = .Top
Pic2W = .Width
Pic2H = .Height
If Pic2W > Pic2H Then
Pic2X = "H"
Else
Pic2X = "V"
End If
End With
Else
Pic2X = "N"
End If
' Next we set the picture format for the current 2 pictures
' Picture Format 1
If (Pic1X = "H") And (Pic2X = "H") Then
PictFormat = 1
Pic1Left = CentimetersToPoints(0)
Pic1Top = CentimetersToPoints(0)
Pic1Width = CentimetersToPoints(15.3)
Pic1Height = CentimetersToPoints(10.21)
Pic2Left = CentimetersToPoints(0)
Pic2Top = CentimetersToPoints(15.04)
Pic2Width = CentimetersToPoints(15.3)
Pic2Height = CentimetersToPoints(10.21)
End If
' Picture Format 2
If (Pic1X = "V") And (Pic2X = "H") Then
PictFormat = 2
Pic1Left = CentimetersToPoints(2.83)
Pic1Top = CentimetersToPoints(-0.89)
Pic1Width = CentimetersToPoints(10.21)
Pic1Height = CentimetersToPoints(15.3)
Pic2Left = CentimetersToPoints(1.05)
Pic2Top = CentimetersToPoints(15.41)
Pic2Width = CentimetersToPoints(15.3)
Pic2Height = CentimetersToPoints(10.21)
End If
' Picture Format 3
If (Pic1X = "H") And (Pic2X = "V") Then
PictFormat = 3
Pic1Left = CentimetersToPoints(0.42)
Pic1Top = CentimetersToPoints(-0.69)
Pic1Width = CentimetersToPoints(15.3)
Pic1Height = CentimetersToPoints(10.21)
Pic2Left = CentimetersToPoints(2.83)
Pic2Top = CentimetersToPoints(10.43)
Pic2Width = CentimetersToPoints(10.21)
Pic2Height = CentimetersToPoints(15.3)
End If
' Picture Format 4
If (Pic1X = "V") And (Pic2X = "V") Then
PictFormat = 4
Pic1Left = CentimetersToPoints(2.83)
Pic1Top = CentimetersToPoints(-0.89)
Pic1Width = CentimetersToPoints(10.1)
Pic1Height = CentimetersToPoints(13.3)
Pic2Left = CentimetersToPoints(2.83)
Pic2Top = CentimetersToPoints(13.09)
Pic2Width = CentimetersToPoints(10.1)
Pic2Height = CentimetersToPoints(13.3)
End If
' Picture Format 5
If (Pic1X = "H") And (Pic2X = "N") Then
PictFormat = 5
Pic1Left = CentimetersToPoints(0.42)
Pic1Top = CentimetersToPoints(-0.69)
Pic1Width = CentimetersToPoints(15.3)
Pic1Height = CentimetersToPoints(10.21)
End If
' Picture Format 6
If (Pic1X = "V") And (Pic2X = "N") Then
PictFormat = 6
Pic1Left = CentimetersToPoints(2.83)
Pic1Top = CentimetersToPoints(-0.89)
Pic1Width = CentimetersToPoints(10.21)
Pic1Height = CentimetersToPoints(15.3)
End If
End If
' Create the index sring
PageString = CStr(PictCurrn)
While Len(PageString) < 3
PageString = "0" & PageString
Wend
PageString = "[" & PageString & "]"
With ActiveDocument.Shapes(PictCurrn)
' Handle Picture1
If (PictCurrn = 1) Then
' Select the picture
.Select
' Move it to the pre-determined position
.Left = Pic1Left
.Top = Pic1Top
.Width = Pic1Width
.Height = Pic1Height
' Add the PageString tag
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.InsertAfter PageString
End If
If (PictCurrn = 2) And (PictFormat < 5) Then
' Select the picture
.Select
' Move it to the pre-determined position
.Left = Pic2Left
.Top = Pic2Top
.Width = Pic2Width
.Height = Pic2Height
' Add the PageString tag
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.InsertAfter PageString
' It's the job of the second picture to add the page break after itself
Selection.InsertBreak Type:=wdPageBreak
End If
If (PictCurrn > 2) And ((PictCurrn Mod 2) = 1) Then
' First picture for new page
.Select
Selection.Cut
Selection.EndKey Unit:=wdLine
Selection.Paste
.Left = Pic1Left
.Top = Pic1Top
.Width = Pic1Width
.Height = Pic1Height
' Add the PageString tag
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.InsertAfter PageString
End If
If (PictCurrn > 2) And ((PictCurrn Mod 2) = 0) And (PictFormat < 5) Then
' Second picture for new page
.Select
Selection.Cut
Selection.EndKey Unit:=wdLine
Selection.Paste
.Left = Pic2Left
.Top = Pic2Top
.Width = Pic2Width
.Height = Pic2Height
' Add the PageString tag
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.InsertAfter PageString
' It's the job of the second picture to add the page break after itself
Selection.InsertBreak Type:=wdPageBreak
End If
End With
Next PictCurrn
End Sub