Solved: Automatically switching from Portait to landscape

[Drifter518]

Hi Everyone,

I'm looking to automatically move some tables around, the problem is some are on landscape oriented pages, so when I move them to a portrait oriented page they are off the page. Is there a way in VBA to check if the table fits, if not to orient the page to landscape??

thanks

[GTO]

Greetings Drifter,

Could you include a sample document with the two different sections?

Mark

[macropod]

Hi Drifter,

Although it's much more than you asked for, the following macro contains code to compare a table's width against the page width.

As coded, the macro vertically splits all tables in a document that exceed the horizontal print margins, replicating the first column along the way. Single-column and two-column tables, including any generated by the split process, are ignored.

You can extract the relevant portions for your own use (you'll need the portions to calculate and compare oPrintWidth and oTableWidth) or, if you decide you don't want landscape tables in some cases, use the macro to split them.

Sub TableSplit()
Application.ScreenUpdating = False
Dim oLeftMargin As Single, oRightMargin As Single, oGutter As Single
Dim oPageWidth As Single, oPrintWidth As Single, oTableWidth As Single
Dim oTable, oCounter As Integer, i As Integer, j As Integer
If ActiveDocument.Tables.Count = 0 Then Exit Sub
With ActiveDocument.PageSetup
oLeftMargin = .LeftMargin
oRightMargin = .RightMargin
oGutter = .Gutter
oPageWidth = .PageWidth
End With
oPrintWidth = oPageWidth - oLeftMargin - oRightMargin - oGutter
oCounter = 1
Restart:
For j = oCounter To ActiveDocument.Tables.Count
oTable = ActiveDocument.Tables(j)
With ActiveDocument.Tables(j)
.AllowAutoFit = False
.PreferredWidth = 0
End With
oTableWidth = 0
If oTable.Columns.Count < 3 Then GoTo SkipTable
For i = 1 To oTable.Columns.Count
oTableWidth = oTableWidth + oTable.Columns(i).Width
If oTableWidth > oPrintWidth Then
oTableWidth = oTableWidth - oTable.Columns(i).Width
oTable.Columns(i).Select
With Selection
.MoveRight Unit:=wdCharacter, Count:=oTable.Columns.Count - i + 1, Extend:=wdExtend
.Copy
.Columns.Delete
.MoveDown Unit:=wdLine, Count:=oTable.Rows.Count
.InsertParagraph
.MoveDown Unit:=wdLine, Count:=1
.Paste
End With
oCounter = j
'Delete the next 6 lines (marked '*) if column 1 is not to be replicated
oTable.Columns(1).Select '*
With Selection '*
.Copy '*
.MoveDown Unit:=wdLine, Count:=2 '*
.Paste '*
End With '*
GoTo Restart
End If
Next
SkipTable:
Next
Application.ScreenUpdating = True
End Sub

[Drifter518]

Hi Macropod,

I was just working with this macro that you sent me and I'm having a problem.

When the macro starts through you read in all the margins, my margins are showing up as 9999999, any idea why that would be?? Is there some sort of initialization I have to do so that it will read them in?? I went to the pagesetup in the Active document and they all look reasonable.

Thanks

jamie

[macropod]

Hi Jamie,

A value of 9999999 usually means 'undefined'. In this case, it's telling you there's more than one Section in the document and they've got different page setups. You can resolve this by specifying the Section to test. For example, instead of:
With ActiveDocument.PageSetup
use:
With ActiveDocument.Sections(#).PageSetup
where # is the Section number, or:
With .Sections(Selection.Information(wdActiveEndSectionNumber)).PageSetup
for the current Section.

With a bit of re-working the code I posted can be made to work with a document having tables in Sections with differing layouts.