Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
My goal:
My first time on VBA. The code will copy the sheet from the workbook where this code resides to every excel file under a xml folder, format some cells in it , and then add footer to all the sheets(total 2). the problem is that only the newly copied sheet in the target file is added footer to. All the code is attached below. I'd appreciate it! Public Sub runCleanup() Dim fs, f, f1, fc Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("Z:\8th_warning\output\xml\") Set fc = f.Files Dim unit As String Dim basebook As Workbook Dim mybook As Workbook Set basebook = ThisWorkbook Application.DisplayAlerts = False For Each f1 In fc Set mybook = Workbooks.Open(f1) mybook.Sheets(1).Activate unit = Right(Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), 4) Call format_this_workbook1(unit) basebook.Worksheets(1).Copy befo=mybook.Sheets(1) 'copy overview to each school ActiveWorkbook.SaveAs Filename:="Z:\8th_warning\output\xls\" & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 3) & "xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close Next Application.DisplayAlerts = True End Sub Private Function format_this_workbook1(unit As String) Dim FinalRow, FinalCol As Integer FinalRow = Range("B65536").End(xlUp).Row FinalCol = Range("A:Q").End(xlToRight).Column - 1 Range("B1").Resize(FinalRow, FinalCol).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With Range("A2:A2").Select For Each ws In Worksheets ws.Activate ActiveSheet.PageSetup.LeftFooterPicture.Filename = "z:\logo\rea_logo_sm2.bmp" With ActiveSheet.PageSetup .LeftFooter = "&G" & Chr(10) & "http://research.cps.k12.il.us" .CenterFooter = "Page &P of &N" .RightFooter = "Unit " & unit .Order = xlOverThenDown .CenterHorizontally = True .CenterVertically = False .Zoom = 100 End With Next ws Sheets(1).Activate End Function |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Avoid using select method. Instead specifically call out worksheets and
workbooks like code changes below. Public Sub runCleanup() Dim fs, f, f1, fc Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("Z:\8th_warning\output\xml\") Set fc = f.Files Dim basebook As Workbook Dim mybook As Workbook Set basebook = ThisWorkbook Application.DisplayAlerts = False For Each f1 In fc Set mybook = Workbooks.Open(f1) With mybook.Sheets(1) Call format_this_workbook1(mybook) 'copy overview to each school basebook.Worksheets(1).Copy befo=mybook.Sheets(1) mybook.SaveAs Filename:="Z:\8th_warning\output\xls\" & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 3) & "xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False mybook.Close End With Next Application.DisplayAlerts = True End Sub Private Function format_this_workbook1(mybook As Workbook) Dim FinalRow, FinalCol As Integer Dim unit As String With myubook.Sheets(1) unit = Right(Left(.Name, Len(.Name) - 4), 4) FinalRow = .Range("B65536").End(xlUp).Row FinalCol = .Range("A:Q").End(xlToRight).Column - 1 With .Range("B1").Resize(FinalRow, FinalCol) .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With For Each ws In mybook.Worksheets With ws.PageSetup .LeftFooterPicture.Filename = "z:\logo\rea_logo_sm2.bmp" .LeftFooter = "&G" & Chr(10) & "http://research.cps.k12.il.us" .CenterFooter = "Page &P of &N" .RightFooter = "Unit " & unit .Order = xlOverThenDown .CenterHorizontally = True .CenterVertically = False .Zoom = 100 End With Next ws End With End Function "Jerry" wrote: My goal: My first time on VBA. The code will copy the sheet from the workbook where this code resides to every excel file under a xml folder, format some cells in it , and then add footer to all the sheets(total 2). the problem is that only the newly copied sheet in the target file is added footer to. All the code is attached below. I'd appreciate it! Public Sub runCleanup() Dim fs, f, f1, fc Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("Z:\8th_warning\output\xml\") Set fc = f.Files Dim unit As String Dim basebook As Workbook Dim mybook As Workbook Set basebook = ThisWorkbook Application.DisplayAlerts = False For Each f1 In fc Set mybook = Workbooks.Open(f1) mybook.Sheets(1).Activate unit = Right(Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), 4) Call format_this_workbook1(unit) basebook.Worksheets(1).Copy befo=mybook.Sheets(1) 'copy overview to each school ActiveWorkbook.SaveAs Filename:="Z:\8th_warning\output\xls\" & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 3) & "xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close Next Application.DisplayAlerts = True End Sub Private Function format_this_workbook1(unit As String) Dim FinalRow, FinalCol As Integer FinalRow = Range("B65536").End(xlUp).Row FinalCol = Range("A:Q").End(xlToRight).Column - 1 Range("B1").Resize(FinalRow, FinalCol).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With Range("A2:A2").Select For Each ws In Worksheets ws.Activate ActiveSheet.PageSetup.LeftFooterPicture.Filename = "z:\logo\rea_logo_sm2.bmp" With ActiveSheet.PageSetup .LeftFooter = "&G" & Chr(10) & "http://research.cps.k12.il.us" .CenterFooter = "Page &P of &N" .RightFooter = "Unit " & unit .Order = xlOverThenDown .CenterHorizontally = True .CenterVertically = False .Zoom = 100 End With Next ws Sheets(1).Activate End Function |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
thanks you so much Joel! I tried the code, but it stopped at "With
myubook.Sheets(1) " in Function format_this_workbook1(mybook As Workbook) with error "Object Required". Can you please help a little further. I'd really appreciate it! "Joel" wrote: Avoid using select method. Instead specifically call out worksheets and workbooks like code changes below. Public Sub runCleanup() Dim fs, f, f1, fc Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("Z:\8th_warning\output\xml\") Set fc = f.Files Dim basebook As Workbook Dim mybook As Workbook Set basebook = ThisWorkbook Application.DisplayAlerts = False For Each f1 In fc Set mybook = Workbooks.Open(f1) With mybook.Sheets(1) Call format_this_workbook1(mybook) 'copy overview to each school basebook.Worksheets(1).Copy befo=mybook.Sheets(1) mybook.SaveAs Filename:="Z:\8th_warning\output\xls\" & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 3) & "xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False mybook.Close End With Next Application.DisplayAlerts = True End Sub Private Function format_this_workbook1(mybook As Workbook) Dim FinalRow, FinalCol As Integer Dim unit As String With myubook.Sheets(1) unit = Right(Left(.Name, Len(.Name) - 4), 4) FinalRow = .Range("B65536").End(xlUp).Row FinalCol = .Range("A:Q").End(xlToRight).Column - 1 With .Range("B1").Resize(FinalRow, FinalCol) .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With For Each ws In mybook.Worksheets With ws.PageSetup .LeftFooterPicture.Filename = "z:\logo\rea_logo_sm2.bmp" .LeftFooter = "&G" & Chr(10) & "http://research.cps.k12.il.us" .CenterFooter = "Page &P of &N" .RightFooter = "Unit " & unit .Order = xlOverThenDown .CenterHorizontally = True .CenterVertically = False .Zoom = 100 End With Next ws End With End Function "Jerry" wrote: My goal: My first time on VBA. The code will copy the sheet from the workbook where this code resides to every excel file under a xml folder, format some cells in it , and then add footer to all the sheets(total 2). the problem is that only the newly copied sheet in the target file is added footer to. All the code is attached below. I'd appreciate it! Public Sub runCleanup() Dim fs, f, f1, fc Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("Z:\8th_warning\output\xml\") Set fc = f.Files Dim unit As String Dim basebook As Workbook Dim mybook As Workbook Set basebook = ThisWorkbook Application.DisplayAlerts = False For Each f1 In fc Set mybook = Workbooks.Open(f1) mybook.Sheets(1).Activate unit = Right(Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), 4) Call format_this_workbook1(unit) basebook.Worksheets(1).Copy befo=mybook.Sheets(1) 'copy overview to each school ActiveWorkbook.SaveAs Filename:="Z:\8th_warning\output\xls\" & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 3) & "xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close Next Application.DisplayAlerts = True End Sub Private Function format_this_workbook1(unit As String) Dim FinalRow, FinalCol As Integer FinalRow = Range("B65536").End(xlUp).Row FinalCol = Range("A:Q").End(xlToRight).Column - 1 Range("B1").Resize(FinalRow, FinalCol).Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With Range("A2:A2").Select For Each ws In Worksheets ws.Activate ActiveSheet.PageSetup.LeftFooterPicture.Filename = "z:\logo\rea_logo_sm2.bmp" With ActiveSheet.PageSetup .LeftFooter = "&G" & Chr(10) & "http://research.cps.k12.il.us" .CenterFooter = "Page &P of &N" .RightFooter = "Unit " & unit .Order = xlOverThenDown .CenterHorizontally = True .CenterVertically = False .Zoom = 100 End With Next ws Sheets(1).Activate End Function |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
It works! I really appreciate your help, Joel! I found the problem. It's was
just a typo. Actually I am a SAS developer. Now I found VBA is real fun too. Thanks again! Best, Jerry. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
how do I copy a footer from Work to Excel | Excel Discussion (Misc queries) | |||
extracting totals from 1 work sheet to another work work sheet | Excel Discussion (Misc queries) | |||
Work Sheet failed to open fully & stuck at one cell only | Excel Worksheet Functions | |||
Headers and Footer on the Chart do not work?????? | Charts and Charting in Excel | |||
Populating work sheet combox with another work sheet values | Excel Discussion (Misc queries) |