アクティブ ビューを画像にエクスポート

Public Sub ExportJPEG()
    Dim ExportFileName As String
    ExportFileName = "D:\Workspace\output.jpg"
    
    Dim ExportResolution As Integer
    ExportResolution = 300
    
    Dim DPI As Integer
    DPI = 96

    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument
    
    Dim pActiveView As IActiveView
    Set pActiveView = pMxDocument.ActiveView
    
    Dim pOutputRasterSettings As IOutputRasterSettings
    Set pOutputRasterSettings = pActiveView.ScreenDisplay.DisplayTransformation
    pOutputRasterSettings.ResampleRatio = 1 'ラスタのピクセル比率を1に変更
        
    Dim pExport As IExport
    Set pExport = New ExportJPEG
    pExport.ExportFileName = ExportFileName     '保存場所
    pExport.Resolution = ExportResolution       '解像度
    
    '出力地図範囲
    Dim pVisibleBounds As IEnvelope
    If TypeOf pActiveView Is IMap Then
        'データ ビューの場合
        Set pVisibleBounds = pActiveView.Extent
    Else
        'レイアウト ビューの場合
        Dim pPageLayout As IPageLayout
        Set pPageLayout = pActiveView
        
        Dim pPage As IPage
        Set pPage = pPageLayout.Page
        
        Dim width As Double
        Dim height As Double
        
        pPage.QuerySize width, height   '用紙サイズ取得
        
        Set pVisibleBounds = New Envelope
        pVisibleBounds.PutCoords 0, 0, width, height
    End If
   
    '出力ラスタ ピクセル サイズ
    Dim pRECT As tagRECT
    pRECT = pActiveView.ExportFrame
    pRECT.Left = 0
    pRECT.Top = 0
    pRECT.Right = pRECT.Right * pExport.Resolution / DPI
    pRECT.bottom = pRECT.bottom * pExport.Resolution / DPI

    Dim pPixelBounds As IEnvelope
    Set pPixelBounds = New Envelope
    pPixelBounds.PutCoords pRECT.Left, pRECT.Top, pRECT.Right, pRECT.bottom

    pExport.PixelBounds = pPixelBounds
    
    Dim hDc As OLE_HANDLE
    hDc = pExport.StartExporting
    
    pActiveView.Output hDc, pExport.Resolution, pRECT, pVisibleBounds, Nothing      '第2引数をあげると出力画像の線が細くなる
    
    pExport.FinishExporting
    pExport.Cleanup
    
    MsgBox "Done"
        
End Sub