Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
A workbook of macros which runs on external workbooks.
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
A workbook of macros which runs on external workbooks.
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. "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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
A workbook of macros which runs on external workbooks.
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
A workbook of macros which runs on external workbooks.
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. "Lostguy" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
A workbook of macros which runs on external workbooks.
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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.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 "Lost" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
I need a macro that runs other macros until P5=28 | Excel Discussion (Misc queries) | |||
Creating a macro that opens and runs multiple workbooks and macros | Excel Programming | |||
Execute Macros from Other workbooks on current workbook | Excel Programming | |||
How to stop other macros while current macro runs | Excel Programming | |||
Which runs first, Workbook_Open() or external query refresh? | Excel Programming |