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 |
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 |
All times are GMT +1. The time now is 03:35 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com