Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default Failed to add footer one of work sheet, Thanks

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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Failed to add footer one of work sheet, Thanks

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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default Failed to add footer one of work sheet, Thanks

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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default It works!: Failed to add footer one of work sheet, Thanks

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
how do I copy a footer from Work to Excel SFTL Excel Discussion (Misc queries) 1 December 10th 09 11:21 PM
extracting totals from 1 work sheet to another work work sheet cj Excel Discussion (Misc queries) 2 October 27th 07 10:54 PM
Work Sheet failed to open fully & stuck at one cell only ScaredSoul Excel Worksheet Functions 3 July 26th 07 05:44 PM
Headers and Footer on the Chart do not work?????? maperalia Charts and Charting in Excel 1 March 20th 06 05:01 PM
Populating work sheet combox with another work sheet values sjayar Excel Discussion (Misc queries) 1 October 29th 05 03:22 PM


All times are GMT +1. The time now is 03:24 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"