View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Lost Lost is offline
external usenet poster
 
Posts: 55
Default Help needed: Getting all sheet setup data from one workbook to ano

All,

Responding to my own post. With Joel's massive guidance this morning, the
code now works like I want. (I probably sloppied-up his code, but I lack his
expertise.)

Run it from your Personal.xls, select a workbook to test, and the report
sheet for what's being tested gets added to Personal.xls. Poof...the setup
data for each sheet in the workbook rather than having to go to each sheet
individually. Thanks Joel and NG!!!!:

Public Sub PageSetupData()
Dim i As Long
Dim wks As Worksheet
NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", Title:="Please select a file")
If NewFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else
On Error GoTo Erro
Workbooks.Open Filename:=NewFN
End If
Set oldbk = Workbooks.Open(Filename:=NewFN)

With ThisWorkbook
Set newsht = .Sheets.Add(after:=.Sheets(.Sheets.Count))
End With

Set Dest = newsht.Range("A1")

On Error Resume Next


With Dest

.Offset(0, 0).Value = "WKS Name"
.Offset(0, 1).Value = "Print Title Rows"
.Offset(0, 2).Value = "Print Title Columns"
.Offset(0, 3).Value = "Print Area"
.Offset(0, 4).Value = "Left Header"
.Offset(0, 5).Value = "Center Header"
.Offset(0, 6).Value = "Right Header"
.Offset(0, 7).Value = "Left Footer"
.Offset(0, 8).Value = "Center Footer"
.Offset(0, 9).Value = "Right Footer"
.Offset(0, 10).Value = "Left Margin"
.Offset(0, 11).Value = "Right Margin"
.Offset(0, 12).Value = "Top Margin"
.Offset(0, 13).Value = "Bottom Margin"
.Offset(0, 14).Value = "Head Margin"
.Offset(0, 15).Value = "Foot Margin"
.Offset(0, 16).Value = "Print Headings"
.Offset(0, 17).Value = "Print Gridlines"
.Offset(0, 18).Value = "Print Comments"
.Offset(0, 19).Value = "Print Quality"
.Offset(0, 20).Value = "Center Horizontally"
.Offset(0, 21).Value = "Center Vertically"
.Offset(0, 22).Value = "Orientation"
.Offset(0, 23).Value = "Draft"
.Offset(0, 24).Value = "Paper Size"
.Offset(0, 25).Value = "First Page Number"
.Offset(0, 26).Value = "Order"
.Offset(0, 27).Value = "Black and White"
.Offset(0, 28).Value = "Zoom"
.Offset(0, 29).Value = "Print Errors"

End With

i = 1
For Each wks In oldbk.Worksheets
Dest.Offset(i, 0).Value = wks.Name

With wks.PageSetup
Dest.Offset(i, 1).Value = .PrintTitleRows
Dest.Offset(i, 2).Value = .PrintTitleColumns
Dest.Offset(i, 3).Value = .PrintArea
Dest.Offset(i, 4).Value = .LeftHeader
Dest.Offset(i, 5).Value = .CenterHeader
Dest.Offset(i, 6).Value = .RightHeader
Dest.Offset(i, 7).Value = .LeftFooter
Dest.Offset(i, 8).Value = .CenterFooter
Dest.Offset(i, 9).Value = .RightFooter
Dest.Offset(i, 10).Value = .LeftMargin
Dest.Offset(i, 11).Value = .RightMargin
Dest.Offset(i, 12).Value = .TopMargin
Dest.Offset(i, 13).Value = .BottomMargin
Dest.Offset(i, 14).Value = .HeaderMargin
Dest.Offset(i, 15).Value = .FooterMargin
Dest.Offset(i, 16).Value = .PrintHeadings
Dest.Offset(i, 17).Value = .PrintGridlines
Dest.Offset(i, 18).Value = .PrintComments
Dest.Offset(i, 19).Value = .PrintQuality
Dest.Offset(i, 20).Value = .CenterHorizontally
Dest.Offset(i, 21).Value = .CenterVertically
Dest.Offset(i, 22).Value = .Orientation
Dest.Offset(i, 23).Value = .Draft
Dest.Offset(i, 24).Value = .PaperSize
Dest.Offset(i, 25).Value = .FirstPageNumber
Dest.Offset(i, 26).Value = .Order
Dest.Offset(i, 27).Value = .BlackAndWhite
Dest.Offset(i, 28).Value = .Zoom
Dest.Offset(i, 29).Value = .PrintErrors
End With


i = i + 1
Next wks


'format worksheet
newsht.Range("B2").FreezePanes = True
newsht.Columns("A:AD").EntireColumn.AutoFit
newsht.Range("B2").Select

exit_Sub:
On Error Resume Next
oldbk.Close savechanges:=False
Exit Sub


err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: PageSetupData - Module: " & _
"Mod_PageSetup_Wkst - " & Now()
GoTo exit_Sub

Erro:

Select Case Err
Case 0
MsgBox "Macro completed successfully (or was cancelled by user)."
Case Else
MsgBox "There is something wrong: " & Chr(10) & _
Err & ": " & Err.Description
End Select

Err.Clear
End Sub