Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 15
Default Help needed: Getting all sheet setup data from one workbook toanother workbook

All,

"Joel" made up the below code, but I would like it to reside in
Personal.xls and run on another workbook that the user chooses
(through application.getopenfilename?). After it extracts the page
setup data from each sheet in the target workbook, it would add a
sheet to Personal.xls and then dump the data to that sheet.(Now you
have report showing the page setup of each page of your target
workbook.)

Right now, it adds the sheet to the target workbook, rather than to
personal.xls.

Any help appreciated! Thanks!
VR/
Lost





Public Sub PageSetupData()
Dim i As Long
Dim wks As Worksheet

'get correct workbook
For Each bk In Workbooks
If bk < ThisWorkbook Then
Set newbk = bk
Exit For
End If
Next bk

With newbk
..Sheets.Add


On Error Resume Next


With .Range("A1")


..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

..Range("A1").Select
For Each wks In .Worksheets
i = i + 1
ActiveCell.Offset(i, 0).Value = wks.Name

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


Next wks


'format worksheet
Range("B2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Columns("A:AD").Select
Columns("A:AD").EntireColumn.AutoFit
Range("B2").Select

End With
exit_Sub:
On Error Resume Next
Exit Sub


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


End Sub
  #2   Report Post  
Posted to microsoft.public.excel.programming
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



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Using a Macro in Excel 2004 to move entered data from one sheet toanother and space between rows when next data is entered? [email protected] Excel Programming 1 June 4th 08 05:08 PM
Export data to new workbook, maintaining formating and page setup KUMPFfrog Excel Programming 2 June 1st 08 10:29 PM
Copy printer setup to new sheet in workbook dougforester Excel Discussion (Misc queries) 1 October 9th 06 09:11 AM
Copying data from workbook/sheets to another workbook/sheet yukon_phil Excel Programming 0 July 26th 06 07:33 PM
loop through a column on a workbook copying data on each row to another workbook, then copy data back to the original workbook burl_rfc Excel Programming 1 April 1st 06 08:48 PM


All times are GMT +1. The time now is 08:26 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"