レイアウト ビューでマップのエクスポート

Public Sub ExportJPEG()
    Dim pMxApplication As IMxApplication
    Dim pMxDocument As IMxDocument
    Dim pActiveView As IActiveView
    Dim pPageLayout As IPageLayout
    Dim pGraphicsContainerSelect As IGraphicsContainerSelect
    Dim pElement As IElement
    Dim pExport As IExport
    Dim pVisibleBounds As IEnvelope
    Dim pPixelBounds As IEnvelope
    Dim pRECT As tagRECT
    Dim hDc As OLE_HANDLE
    Dim width  As Double
    Dim height As Double
    
    Set pMxApplication = Application
    Set pMxDocument = ThisDocument
    Set pActiveView = pMxDocument.ActiveView
    Set pPageLayout = pActiveView
    Set pGraphicsContainerSelect = pPageLayout
    
    Set pExport = New ExportJPEG
    pExport.ExportFileName = "D:\Workspace\test_JPEGExport1.jpg"    '保存場所
    pExport.Resolution = 300                                        '解像度
    
    pRECT.Left = 0
    pRECT.Top = 0
    
    If pGraphicsContainerSelect.ElementSelectionCount = 0 Then
        'レイアウト ビューでフレーム エレメントを選択していない場合、用紙領域で出力
        Dim pPrinter As IPrinter
        Set pPrinter = pMxApplication.Printer
        Dim pPage As IPage
        Set pPage = pPageLayout.Page
        pPage.Units = esriCentimeters
        pPage.QuerySize width, height
        Set pVisibleBounds = pActiveView.Extent
        
        pRECT.Right = width * pExport.Resolution
        pRECT.bottom = height * pExport.Resolution
        
        Set pPixelBounds = New Envelope

    Else
        'フレーム エレメントを一つ選択している場合、グラフィックス範囲に出力をクリップ
        Set pElement = pGraphicsContainerSelect.SelectedElement(0)
        Set pPixelBounds = pElement.Geometry.Envelope
        Set pVisibleBounds = pElement.Geometry.Envelope
        
        pRECT.Right = pPixelBounds.width * pExport.Resolution / 96 ' このサイズがResolutionに近いと出力結果が白くなる
        pRECT.bottom = pPixelBounds.height * pExport.Resolution / 96
        'この値が小さくなると、PDFを拡大した際にシンボルがより大きく表現されてしまいます(ArcGISでPDFを出力した際のレイヤのシンボルサイズが、Adobe Readerで100%で表示した際に見えるシンボルと一致となるため)。PDFを出力する範囲によらずシンボルサイズを一定に出力するには、マップの表示縮尺を常に一定にする(ジオメトリの範囲に拡大して表示する)などの考慮が必要となりますのでご注意ください。

    End If

    pPixelBounds.PutCoords pRECT.Left, pRECT.Top, pRECT.Right, pRECT.bottom
    pExport.PixelBounds = pPixelBounds
    
    hDc = pExport.StartExporting
    
    pActiveView.Output hDc, pExport.Resolution, pRECT, pVisibleBounds, Nothing
    
    pExport.FinishExporting
    pExport.Cleanup
        
End Sub