View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default A workbook of macros which runs on external workbooks.

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


"Lostguy" wrote:

Hello!
You guys made up this handy macro which I put in one workbook
(Tester.xls). It opens, checks sheet and workbook protection status,
and closes an external workbook (Tested.xls) based on a dialogue box.
Pretty cool little code. (My sheet names were too long for the popup
msgbox, so I had to put a counter in there and use sheet numbers
instead. Anybody know how to make the msgbox big so I can use sheet
names and still display the status of 45 sheets?)

Sub ProtectedStatus()
Dim wks As Worksheet
Dim result As String
Dim i As Integer
Dim Count As Integer
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
Workbooks.Open Filename:=NewFN
End If
Set oldbk = Workbooks.Open(Filename:=NewFN)
result = ""
Count = ActiveWorkbook.Worksheets.Count
i = 0
For Each wks In ActiveWorkbook.Worksheets
i = i + 1
result = result & i & " " & IIf(wks.ProtectContents, "OK",
"unprotected") & vbCr
Next wks
MsgBox result
X = False
If ActiveWorkbook.ProtectWindows Then X = True
If ActiveWorkbook.ProtectStructure Then X = True
If X = False Then
MsgBox "The workbook is not protected."
Else
MsgBox "The workbook is protected."
End If
oldbk.Close savechanges:=False
End Sub

Anyway,

Your group also made up the macro below to display a report of the
page setup of every sheet. The problem is that it puts the report
inside the workbook being examined (Tested.xls) rather than in the
workbook I am running it from (Tester.xls). It needs the same open
workbook dialogue box as above but I can't seem to put the two
together.

Any sheets being added should add to Tester.xls rather than the files
being examined. Here's the second macro:

'/=================================================/
' Sub Purpose: list pagesetup info for all worksheets
' in current workbook
'/=================================================/
'
Public Sub PageSetupData()
Dim i As Long
Dim wks As Worksheet

Sheets.Add


On Error Resume Next


Range("A1").Select


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


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


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



A lot of writing for a small question. I am just trying to set up one
macro workbook to run macros on external files rather than put the
macros within the examined workbook themselves and I can't get the
second macro to be able to choose the external file and then add the
report sheet to the macro workbook rather than the tested workbook.

I appreciate the help!

VR/

Lost