A workbook of macros which runs on external workbooks.

L

Lostguy

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
 
J

Joel

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
 
J

JLGWhiz

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?

I think I would design a UserForm with a Multipage TextBox to do the job.
You can customize the size and shape of your UserForm and its controls.
Takes a little work but it might be worth the effort for 45 sheets.
 
L

Lostguy

Joel,

The code fails at "If bk <> ThisWorkbook Then" (Object does not
support method/property).
Also, does this open the Open File dialogue box the same as
GetOpenFilename? That is what I was trying to use.

JLGWhiz: I might just go that route . (Or I can just shorten my
sheetnames.) Thanks!

VR/

Lost
 
J

Joel

change the line to this

If bk.Name <> ThisWorkbook.Name Then

If thought the original code would run without using the NAME property.

The two macros that you posted looked like they would meant to run
seperately. Because you open the file already with the GetOpenFilename
method in the 1st macro; I assumed when you ran the 2nd macro the two files
were already opened and you didn't want to use the workbook where the macro
was located.

So my code selectes the 2nd workbook that is opened.
 
L

Lost

Joel,

Thanks for your help and sorry about the confusion.

No, right now, the macro tests the current workbook (good), but adds a sheet
to it (bad).

I was wanting to run the macro from my Personal.xls and if any sheets get
added, they would add to Personal.xls rather than the file being tested. (I
don't want to mess with the tested sheets if I don't have to.)

I thought that the GetFileName thing (which worked for another macro) would
work for that, but I couldn't get GetFileName to work with the macro you
designed. It's in that top section where you select the workbook but I don't
know enough to get it to work.

Anyway, I appreciate the help!

VR/

Lost
 
J

Joel

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

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

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

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Duplicate declaration in scope 2
Help needed: Getting all sheet setup data from one workbook toanother workbook 1
= CHAR(Row() + 61) 2
Error 2042 problem with vlookup 0
Code does not error but no copy either 4
Entering data from a userform into multiple sheets 2
Combobox will not show list 4
Need help-For loop 3

Top