'---------------------------------------------------------------------------------------
' Procedure : PrinWrkShtRng
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Print a specified worksheet range
' Copyright : It is not to be altered or distributed,
'             except as part of an application.
'             You are free to use it in any application,
'             provided the copyright notice is left unchanged.
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strWrkBk      Workbook file name(full path and filename)
' strWrkSht     Worksheet name which whose range are to be printed
' strRng        Worksheet Range to be printed
'
'
' Revision History:
' Rev       Date(yyyy/mm)           Description
' **************************************************************************************
' 1         2008-Feb                Initial Release
'---------------------------------------------------------------------------------------
Function PrinWrkShtRng(strWrkBk As String, strWrkSht As String, strRng As String)
On Error GoTo PrinWrkShtRng_Error
    Dim xlApp       As Object
    Dim xlWrkBk     As Object
    Dim xlWrkSht    As Object

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
    
    If Err.Number <> 0 Then
        'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo PrinWrkShtRng_Error
        Set xlApp = CreateObject("excel.application")
    Else
        On Error GoTo PrinWrkShtRng_Error
    End If

    xlApp.Visible = True 'make excel visible to the user
    Set xlWrkBk = xlApp.Workbooks.Open(strWrkBk)

    Set xlWrkSht = xlApp.Worksheets(strWrkSht)

    With xlWrkSht.PageSetup
        .PrintArea = strRng
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
        .Orientation = xlLandscape
    End With

    xlWrkSht.PrintOut Copies:=1

    xlWrkBk.Close False
    xlApp.Close
    
    Set xlWrkSht = Nothing
    Set xlWrkBk = Nothing
    Set xlApp = Nothing
    
Exit Function

PrinWrkShtRng_Error:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: PrinWrkShtRng" & vbCrLf & _
    "Error Description: " & Err.Description, vbCritical, "An Error has Occurred!"
    Exit Function
    
End Function