Tony Strazzeri said:
Hi aal,
Apologies for the repost (if it appears). I posted a reply but it has
not appeared when I looked for it so heregoes (again).
The following code will create the layout I am referring to.
It contains two sections only so that I can format the first page as
two columns and the second as three. The sections are not needed to
implement the different Odd/Even pages.
The first page has several shapes in the header to simulate possible
graphic/layout elements. The second page has a different banner
across the top. These are in the headers so that the user does not
need to worry about shifting them accidentally.
The main body of the document can just have the text content.
It is up to the user to ensure that the content for each page is
limited to a single page otherwise the text will frlow onto the next
page and carry the column formatting but will of course have the
appropriate odd/even header/banner.
If you want additional sets of layout in the same document you just
need to insert a section break at the end of each page pair and adjust
the column count and headers accordingly. Hope this helps.
Hi Tony,
I have modified your code so as to avoid the Selection object, and,more
importantly, the SeekView bits... SeekView can lead to all kinds of
problems... Try to stay clear...
Option Explicit
Sub DemoTwoPageFlyerLayout()
Dim i As Long
Dim shp As Shape
Dim rgeDoc As Range
Dim rgeAnchor As Range
Const strSomeText = "The quick brown fox jumps over the lazy dog. The quick
brown fox jumps over the lazy dog. " _
& "The quick brown fox jumps over the lazy dog. The quick brown fox
jumps over the lazy dog. " _
& "The quick brown fox jumps over the lazy dog." & vbCr _
& "The quick brown fox jumps over the lazy dog. The quick brown fox
jumps over the lazy dog. " _
& "The quick brown fox jumps over the lazy dog. The quick brown fox
jumps over the lazy dog."
With ActiveDocument.PageSetup
.Orientation = wdOrientPortrait
.OddAndEvenPagesHeaderFooter = True
.DifferentFirstPageHeaderFooter = False
With .TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
.Width = CentimetersToPoints(6.99)
.Spacing = CentimetersToPoints(1.27)
End With
End With
Set rgeAnchor =
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
rgeAnchor.Collapse
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
Set shp = .AddShape(msoShapeHorizontalScroll, 130, 10#, 380#, 120#,
rgeAnchor)
shpAdjust shp, 130, 10, "This is the banner"
Set shp = .AddShape(msoShapeDoubleBracket, 18.6, 45#, 99.75, 693#,
rgeAnchor)
shpAdjust shp, 18.6, 45, "This could have Addess and contact information."
Set shp = .AddShape(msoShapeFlowchartSequentialAccessStorage, 292.2,
324#, 262.2, 117#, rgeAnchor)
shpAdjust shp, 292.2, 324, "News of the Week"
End With
With ActiveDocument.Sections(1).Footers(wdHeaderFooterEvenPages)
Set rgeAnchor = .Range
rgeAnchor.Collapse
.Range.Text = "This is in the back/even page footer"
Set shp = .Shapes.AddShape(msoShapeWave, 89.85, 45#, 459#, 45#, rgeAnchor)
shpAdjust shp, 89.85, 45, "This banner is on the Even pages"
End With
Set rgeDoc = ActiveDocument.Range
With rgeDoc
.InsertAfter "This text appears in the document body. The other stuff is
in the header, but it could be in both header and footer."
.InsertParagraphAfter
.InsertParagraphAfter
'Add some text
For i = 1 To 5
.InsertAfter strSomeText
Next
.InsertParagraphAfter
.InsertParagraphAfter
.Collapse wdCollapseEnd
.InsertBreak Type:=wdSectionBreakNextPage
End With
With ActiveDocument.Sections(2).PageSetup.TextColumns
.SetCount NumColumns:=3
.EvenlySpaced = True
.LineBetween = True
End With
With rgeDoc
For i = 1 To 5
.InsertAfter strSomeText
Next
.InsertParagraphAfter
End With
End Sub
Function shpAdjust(shpTarget As Shape, sngLeft As Single, _
sngTop As Single, strText As String)
With shpTarget
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeHorizontalPositionPage
.LockAnchor = False
.Left = sngLeft
.Top = sngTop
With .WrapFormat
.Type = wdWrapTight
.AllowOverlap = False
End With
.TextFrame.TextRange.Text = strText
End With
End Function
By the way, I may not respond for a while as I do not normally monitor the
vba.beginners group because at work I have to use the MSFT Web Interface, and
MSFT, in their infinite wisodm, have decided not to inlcude vba.beginners,
vba.userforms, etc. within the Office list of discussion groups. Go figure!
I had to do a search to find this post. Strangely, a search gives me access,
but he group itself is not listed in the left margin...
How silly is that?
Very...
