Map を用紙の最大範囲で印刷する方法

'******************************************************************************
' 定義      :Function fncPrintMap
' 概要      :Mapを用紙全体に印刷する関数
' 第1引数   :pActiveVeiw            As  IActiveView ActiveView
' 第2引数   :intOrientation         As  Integer     用紙方向 縦:1, 横:2
' 第3引数   :strPrinterName         As  String      プリンタ名を文字列で指定
' 第4引数   :strTargetForm          As  String      用紙サイズを文字列で指定
' 第5引数   :Optional sTrayName     As  String      プリンタトレイを文字列で指定
' 第6引数   :Optional blnPsPrinter  As  Boolean     PsPrinterを使用するか判断
' 第7引数   :Optional intResolution As  Integer     印刷解像度（PsPrinter使用時のみ設定）
' 戻り値    :なし
'******************************************************************************
Function fncPrintActiveView(pMap As IMap, _
                            intOrientation As Integer, _
                            strPrinterName As String, _
                            strTargetForm As String, _
                            Optional strTrayName As String, _
                            Optional blnPsPrinter As Boolean, _
                            Optional intResolution As Integer)
                             
    'ActiveViewの取得
    Dim pActiveView As IActiveView
    Set pActiveView = pMap
 
    'プリンタとトレイの設定
    Dim pPaper As IPaper
    Set pPaper = New Paper
     
    Dim pPaper2  As IPaper2
    Set pPaper2 = pPaper
         
    pPaper.PrinterName = strPrinterName 'インストールされているプリンタを文字列で指定
    pPaper.Orientation = intOrientation '1:縦 2:横
     
    Dim pEnumTypeInfo As IEnumNamedID
    Set pEnumTypeInfo = pPaper.Forms
    pEnumTypeInfo.Reset
     
    Dim iFormId As Long
    Dim sFormName As String
    iFormId = pEnumTypeInfo.Next(sFormName)
     
    Do While (InStr(1, sFormName, strTargetForm, vbTextCompare) < 1) And (iFormId > 0)
     
'        Debug.Print "FormID:" & iFormId & vbTab & "FormName:" & sFormName
        iFormId = pEnumTypeInfo.Next(sFormName)
        DoEvents
    Loop
     
'    Debug.Print "   FormID:" & iFormId & vbTab & "FormName:" & sFormName;
'    Debug.Print ":" & strTargetForm & "対象のプリンタ"
     
    '通常設定のプリンタでTarget Formが見つからなかった場合
    If iFormId = 0 Then
        MsgBox "対象の用紙サイズは印刷できません"
        Exit Function
    End If
     
    'Target Formが見つかった場合FormIDをPaperオブジェクトにセット
    pPaper.FormID = iFormId
     
    Dim pEnumNamedID As IEnumNamedID
    Set pEnumNamedID = pPaper.Trays
    pEnumNamedID.Reset
     
    Dim sName As String, lID As Long
    lID = pEnumNamedID.Next(sName)
     
    Do Until lID = 0
        Debug.Print lID, sName
        lID = pEnumNamedID.Next(sName)
         
        If sName = strTrayName Then
            pPaper.TrayID = lID
            Exit Do
        End If
     
    Loop
     
     
    '印刷設定
 
    '印刷可能範囲を取得
    Dim intWidth As Double
    Dim intHeight As Double
    pPaper.QueryPaperSize intWidth, intHeight
    Debug.Print "1 Width:" & intWidth, "Height:" & intHeight
     
     
    Dim pPrinter As IPrinter
    Dim lScrRes As Long '印刷解像度の定義
     
    '新規作成するPrinterオブジェクトを指定
    If blnPsPrinter = True Then
        Set pPrinter = New PsPrinter
        lScrRes = intResolution
         
    Else
        Set pPrinter = New EmfPrinter
        lScrRes = pPaper2.Resolution
    End If
     
    Set pPrinter.Paper = pPaper
     
    pPrinter.QueryPaperSize intWidth, intHeight
    Debug.Print "2 Width:" & intWidth, "Height:" & intHeight
     
    Dim pDisplayTransformation As IDisplayTransformation
    Set pDisplayTransformation = pActiveView.ScreenDisplay.DisplayTransformation
         
    '印刷ピクセル数を計算
    Dim deviceRECT As tagRECT
    deviceRECT = pDisplayTransformation.DeviceFrame
     
    With deviceRECT
        .bottom = intHeight * lScrRes
        .Left = 0
        .Right = intWidth * lScrRes
        .Top = 0
    End With
         
    Dim pDriverBounds As IEnvelope
    Set pDriverBounds = New Envelope
     
    Dim pVisibleBounds As IEnvelope
    Dim hDC As Long
     
    'CancelTrackerの作成
    Dim pCancel As ITrackCancel
    Set pCancel = New CancelTracker
    pCancel.CancelOnClick = False
    pCancel.CancelOnKeyPress = False
 
    'ActiveViewがMapの場合
    pDriverBounds.PutCoords deviceRECT.Left, deviceRECT.bottom, deviceRECT.Right, deviceRECT.Top
     
    hDC = pPrinter.StartPrinting(pDriverBounds, 0)
    pActiveView.Output hDC, lScrRes, deviceRECT, Nothing, pCancel    'マップの長辺が用紙にフィットするように印刷
    pPrinter.FinishPrinting
 
End Function
 
'MapControlの表示範囲を印刷するサンプル
'参考:http://www.esrij.com/support/arcobjects/samples/Developer_Guide_Scenarios/ArcGIS_Desktop/Illustrated_Code_Samples/Print_Current_View.html