Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Using a Macro in Excel 2004 to move entered data from one sheet toanother and space between rows when next data is entered? | Excel Programming | |||
Export data to new workbook, maintaining formating and page setup | Excel Programming | |||
Copy printer setup to new sheet in workbook | Excel Discussion (Misc queries) | |||
Copying data from workbook/sheets to another workbook/sheet | Excel Programming | |||
loop through a column on a workbook copying data on each row to another workbook, then copy data back to the original workbook | Excel Programming |