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