Hi Everybody,
I've written some code which prints worksheets were a range is not
empty for each workbook in a directory. As below.
I'd like to use the getdirectory to choose the root directory. then
run the Printworkbooks(spath) for each directory below it. e.g. all
it's sub directories. I've had a look around and i'm not sure how to
work it out.
So the way i see it i would call the getdirectory command, it would
firstly run Printworkbooks(rootpath), then loop through each
subdirectory running the PrintWorkbooks(subdirectory), for each sub
directory.
Does anyone have any code they could help me with?
Public Sub PrintWorkbooks(spath As String)
Dim sCurFile As String
Dim Msg As String
If spath <> "" Then
On Error Resume Next
Application.ScreenUpdating = False
If Right(spath, 1) <> "\" Then
spath = spath & "\"
End If
sCurFile = Dir$(spath & "*.xls", vbNormal)
Do While Len(sCurFile) <> 0
Workbooks.Open spath & sCurFile, , True
With Workbooks(sCurFile)
Call PrintWorksheets
ActiveWorkbook.Close SaveChanges:=False
End With
sCurFile = Dir
DoEvents
Loop
Application.ScreenUpdating = True
On Error GoTo 0
End If
End Sub
------------------------------------------------------
Sub PrintWorksheets()
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
If Not RangeIsEmpty(wks.Range("$C$13:$F$26")) Then
wks.PrintOut
End If
Next
Set wks = Nothing
End Sub
------------------------------------------------------
Function RangeIsEmpty(ByVal SourceRange As Range) As Boolean
RangeIsEmpty = (WorksheetFunction.CountA(SourceRange) = 0)
End Function
------------------------------------------------------
Sub PrintDirectory()
Dim dpath As String
'Get the path
Msg = "Choose which directory to print timesheets from"
dpath = GetDirectory(Msg)
Call PrintWorkbooks(dpath)
End Sub
--~--~---------~--~----~------------~-------~--~----~
Visit the blog to download Excel tutorials at
http://www.excel-macros.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
For more options, visit this group at
http://groups.google.com/group/excel-macros?hl=en
Visit & Join Our Orkut Community at
http://www.orkut.com/Community.aspx?cmm=22913620
Visit the blog to download Excel tutorials at
http://www.excel-macros.blogspot.com
To Learn VBA Macros Please visit http://www.vbamacros.blogspot.com
To see the Daily Excel Tips, Go to:
http://exceldailytip.blogspot.com
-~----------~----~----~----~------~----~------~--~---
