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

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