Hi,
I was wondering if someone can post a code... taht would essentially loop through all the worksheets in an Excel file.
thanks.
Printable View
Hi,
I was wondering if someone can post a code... taht would essentially loop through all the worksheets in an Excel file.
thanks.
this should be in Office section..
but
VB Code:
For x = 1 to ActiveWorkbook.Sheets.Count Msgbox Sheets(x).name Next
THe essentially automatically places footers to all documents in a directory... So what your code does is loop through the files and and visually shows that. I need the program to loop throuhg the worksheets and automatically put in the footer. This is the code I have:
ub MacroUpdateFooter()
'
' MacroUpdateFooter Macro
' Macro recorded 7/28/2006 by Blue2man
'
Dim tmp As String
Dim ext As String
Dim XLS As Variant
Dim sPath As String
sPath = "c:\baseline\"
tmp = Dir(sPath & "*.*")
Do While tmp > ""
ext = LCase(Right(tmp, 3))
Select Case ext
Case "xls"
Set XLS = New Application
XLS.Workbooks.Open sPath & tmp
XLS.ActiveSheet.PageSetup.PrintArea = ""
With XLS.ActiveSheet.PageSetup
.LeftFooter = "&D"
.CenterFooter = "&Z&F"
.RightFooter = "&P"
End With
XLS.ActiveWorkbook.Save
XLS.Quit
Set XLS = Nothing
For x = 1 To ActiveWorkbook.Sheets.Count
MsgBox Sheets(x).Name
Next
Case "doc"
'Set WRD = New Word.Application
'WRD.Documents.Open sPath & tmp
'etc
'etc
'WRD.ActiveDocument.Save
'RD.Quit
'Set WRD = Nothing
Case "ppt"
Case "???" ' visio
End Select
tmp = Dir
Loop
MsgBox "Job Complete"
End Sub
Ignore the Case DOc...
Use a For...Each loop. The other thing you should probably do is avoid references to ActiveBook and ActiveSheet. These can be disasterous if the user accidentally hits an Excel instance on the taskbar when your code is running.
VB Code:
Dim oSheet As Excel.Worksheet, oBook As Excel.Workbook '.... Case "xls" Set XLS = New Application Set oBook = XLS.Workbooks.Open(sPath & tmp) For Each oSheet In oBook.Worksheets With oSheet.PageSetup .PrintArea = "" .LeftFooter = "&D" .CenterFooter = "&Z&F" .RightFooter = "&P" End With Next oSheet oBook.Save Set oBook = Nothing XLS.Quit Set XLS = Nothing 'Etc
Moved to Office Development