I want to take a random number of pictures that are all pasted onto the first "Page" of a Word document and distribute them across multiple pages in the same document, 2 per page. So if there were 10 pictures on the first page, 1 and 2 would stay on the first page. 3 and 4 would be moved to the second (3 at the top, 4 at the bottom). 5 and 6 would move to the third page, etc...
And to make things a little more complicated, a string with the image number has to be placed at the bottom of each image. And each image needs to be positioned and sized based on if they are horizontal/vertical, horizontal/horizontal, vertical/vertical, or vertical/horizontal.
I've got the code written, but the added breaks aren't showing up where I thought they would.
Anyone feel like reviewing some code? P.S. I'm very new to VBA so please don't be too harsh. Constructive is always welcome though.
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