Private Type My_ArcObjects
    IMxApplication              As IMxApplication
    IPrinter                    As IPrinter
    IPaper                      As IPaper
    IPageLayout                 As IPageLayout
    IEmfPrinter                 As IEmfPrinter
    IExport                     As IExport
    IScreenDisplay              As IScreenDisplay
    ISimpleRenderer             As ISimpleRenderer
    ISimpleFillSymbol           As ISimpleFillSymbol
    IDraw                       As IDraw
    IClone                      As IClone
   
    IMxDocument                 As IMxDocument
    IActiveView                 As IActiveView
    Imap                        As Imap
    IMaps                       As IMaps
    IGeoFeatureLayer            As IGeoFeatureLayer
    ILayer                      As ILayer
    IDisplayTransformation      As IDisplayTransformation
   
    IField                      As IField
    IFields                     As IFields
    IFieldsEdit                 As IFieldsEdit
    IFieldEdit                  As IFieldEdit
    ICursor                     As ICursor
    IRow                        As IRow
    ITable                      As ITable
    ISelectionSet               As ISelectionSet
    IQueryFilter                As IQueryFilter
    IFeatureSelection           As IFeatureSelection
    IFeatureLayer               As IFeatureLayer
    IFeatureCursor              As IFeatureCursor
    IFeature                    As IFeature
    IDataSet                    As IDataSet
    IEnvelope                   As IEnvelope
    IFeatureClass               As IFeatureClass
    IEnumVertex                 As IEnumVertex

    ICommandItem                As ICommandItem
    ICommandBar                 As ICommandBar
    ICommandBars                As ICommandBars

    IWorkspaceFactory           As IWorkspaceFactory
    IPropertySet                As IPropertySet
    IWorkspace                  As IWorkspace
    IFeatureWorkspace           As IFeatureWorkspace
    IPoint                      As IPoint
    IPointCollection            As IPointCollection
    ICurve                      As ICurve
    IPolygon                    As IPolygon
    ILine                       As ILine
    IGeometry                   As IGeometry
    IGeometryCollection         As IGeometryCollection
    IGeometryDefEdit            As IGeometryDefEdit
    IGeometryDef                As IGeometryDef
    ISpatialReference           As ISpatialReference
    IWorkspaceEdit              As IWorkspaceEdit
    SpatialReferenceEnvironment As SpatialReferenceEnvironment

    IProjectedCoordinateSystem  As IProjectedCoordinateSystem
    IAnnotateLayerPropertiesCollection As IAnnotateLayerPropertiesCollection

End Type

Private Type this
    A               As My_ArcObjects
    Message         As String
    color           As RgbColor

End Type

Dim g As New Class_Global
Private this As this

'=======================================================
'            Class Initialize
'=======================================================
Private Sub Class_Initialize()
    Set this.A.IMxDocument = ThisDocument
    Set this.A.IMxApplication = Application
    Set this.A.IMaps = this.A.IMxDocument.Maps
End Sub
'=======================================================
'            Messsage (Let)
'=======================================================
Public Property Let Message(Text As String)
    this.Message = Text
End Property

'=======================================================
'            Message (Get)
'=======================================================
Public Property Get Message() As String
    Message = this.Message
End Property
'=======================================================
'           TurnOnAllLayers
'=======================================================
Public Sub TurnOnAllLayers()
    Dim i
    Dim j
     
    For i = 1 To this.A.IMaps.Count
        Set this.A.Imap = this.A.IMaps.Item(i - 1)
        For j = 1 To this.A.Imap.LayerCount
            Set this.A.ILayer = this.A.Imap.Layer(j - 1)
            this.A.ILayer.Visible = True
        Next j
    Next i

    this.A.IMxDocument.UpdateContents
    this.A.IMxDocument.ActiveView.Refresh
End Sub
'=======================================================
'           TurnOffAllLayers
'=======================================================
Public Sub TurnOffAllLayers()
    Dim i
    Dim j
        
    For i = 1 To this.A.IMaps.Count
        Set this.A.Imap = this.A.IMaps.Item(i - 1)
        For j = 1 To this.A.Imap.LayerCount
            Set this.A.ILayer = this.A.Imap.Layer(j - 1)
            this.A.ILayer.Visible = False
        Next j
    Next i

    this.A.IMxDocument.UpdateContents
    this.A.IMxDocument.ActiveView.Refresh
End Sub

'=======================================================
'               ZoomIn
'=======================================================
Public Sub ZoomIn()
    Dim Center As IPoint
    
    Set this.A.IMxDocument = Application.Document
    Set this.A.IActiveView = this.A.IMxDocument.FocusMap
    
    Set this.A.IDisplayTransformation = this.A.IActiveView.ScreenDisplay.DisplayTransformation
    Set this.A.IEnvelope = this.A.IActiveView.Extent

    Set Center = New Point
    Center.x = (this.A.IEnvelope.XMax + this.A.IEnvelope.xmin) / 2
    Center.y = (this.A.IEnvelope.YMax + this.A.IEnvelope.ymin) / 2
    this.A.IEnvelope.width = this.A.IEnvelope.width / 2
    this.A.IEnvelope.height = this.A.IEnvelope.height / 2
    this.A.IEnvelope.CenterAt Center
    
    this.A.IDisplayTransformation.visibleBounds = this.A.IEnvelope
    this.A.IActiveView.Refresh
     
End Sub
'=======================================================
'               ZoomOut
'=======================================================
Public Sub ZoomOut()
    Dim Center As IPoint
    
    Set this.A.IActiveView = this.A.IMxDocument.FocusMap
    
    Set this.A.IDisplayTransformation = this.A.IActiveView.ScreenDisplay.DisplayTransformation
    Set this.A.IEnvelope = this.A.IActiveView.Extent

    Set Center = New Point
    Center.x = (this.A.IEnvelope.XMax + this.A.IEnvelope.xmin) / 2
    Center.y = (this.A.IEnvelope.YMax + this.A.IEnvelope.ymin) / 2
    this.A.IEnvelope.width = this.A.IEnvelope.width / 0.2
    this.A.IEnvelope.height = this.A.IEnvelope.height / 0.2
    this.A.IEnvelope.CenterAt Center
    
    MsgBox "x value:" & Center.x & "  Y: " & Center.y
    
    this.A.IDisplayTransformation.visibleBounds = this.A.IEnvelope
    this.A.IActiveView.Refresh
     
End Sub
'=======================================================
'          CenterTo
'=======================================================
Public Sub CenterTo(x, y)
    Dim Center As IPoint
    
    Set this.A.IActiveView = this.A.IMxDocument.FocusMap
    
    Set this.A.IDisplayTransformation = this.A.IActiveView.ScreenDisplay.DisplayTransformation
    Set this.A.IEnvelope = this.A.IActiveView.Extent

    Set Center = New Point
    Center.x = x
    Center.y = y

    this.A.IEnvelope.CenterAt Center
    
    this.A.IDisplayTransformation.visibleBounds = this.A.IEnvelope
    this.A.IActiveView.Refresh
     
End Sub
'=======================================================
'            ShowCenter
'=======================================================
Public Sub ShowCenter(x, y)
    Dim Center As IPoint
    
    Set this.A.IActiveView = this.A.IMxDocument.FocusMap
    Set this.A.IDisplayTransformation = this.A.IActiveView.ScreenDisplay.DisplayTransformation
    Set this.A.IEnvelope = this.A.IActiveView.Extent

    Set Center = New Point
    Center.x = (this.A.IEnvelope.XMax + this.A.IEnvelope.xmin) / 2
    Center.y = (this.A.IEnvelope.YMax + this.A.IEnvelope.ymin) / 2
    
    MsgBox "X value: " & Center.x & " " & vbCrLf & _
           "Y value: " & Center.y & " " & vbCrLf & _
           "Height: " & this.A.IEnvelope.height & vbCrLf & _
           "Width: " & this.A.IEnvelope.width
            
     
End Sub
 
'=======================================================
'                FindLayer
'=======================================================
Public Function FindLayer(name)
    Dim i, j
    
    FindLayer = True
   
    For i = 0 To this.A.IMaps.Count - 1
        Set this.A.Imap = this.A.IMaps.Item(i)
    
        For j = 0 To this.A.Imap.LayerCount - 1
            If TypeOf this.A.Imap.Layer(j) Is IFeatureLayer Then
                Set this.A.IFeatureLayer = this.A.Imap.Layer(j)
                If (LCase(this.A.IFeatureLayer.name) = LCase(name)) Then Exit Function
            End If
        Next j
    Next i
  
    FindLayer = False
End Function
'=======================================================
'                Turn Off Layer
'=======================================================
Public Function TurnOffLayer(name)
    If (Not FindLayer(name)) Then Exit Function
    
    Set this.A.ILayer = this.A.IFeatureLayer
    this.A.ILayer.Visible = False
    this.A.IMxDocument.UpdateContents
    this.A.IMxDocument.ActiveView.Refresh
End Function
'=======================================================
'                Turn On Layer
'=======================================================
Public Function TurnOnLayer(name)
    If (Not FindLayer(name)) Then Exit Function
    
    Set this.A.ILayer = this.A.IFeatureLayer
    this.A.ILayer.Visible = True
    this.A.IMxDocument.UpdateContents
    this.A.IMxDocument.ActiveView.Refresh
End Function
'=======================================================
'               Add Shapefile
'=======================================================
Public Function AddShapeFile(filename)

    Set this.A.IWorkspaceFactory = New ShapefileWorkspaceFactory
    Set this.A.IFeatureWorkspace = this.A.IWorkspaceFactory.OpenFromFile(g.ExtractFilepath(filename), 0)
    Set this.A.IFeatureClass = this.A.IFeatureWorkspace.OpenFeatureClass(g.ExtractFileNam(filename))

    Set this.A.IFeatureLayer = New FeatureLayer
    Set this.A.IFeatureLayer.FeatureClass = this.A.IFeatureClass

    this.A.IFeatureLayer.name = this.A.IFeatureClass.AliasName
    this.A.IMxDocument.AddLayer this.A.IFeatureLayer
    this.A.IMxDocument.ActiveView.PartialRefresh esriViewGeography, this.A.IFeatureLayer, Nothing

End Function

'=======================================================
'               PrintActiveView
'=======================================================
Public Sub PrintActiveView()
    
    Dim deviceBounds As IEnvelope
    Dim deviceFrame As tagRECT
    Dim visibleBounds As IEnvelope
    Dim pageLayoutView As IActiveView
    Dim printableBounds As IEnvelope

    Dim hDC As Long
    Dim xmin
    Dim ymin

    Set deviceBounds = New Envelope
    Set visibleBounds = New Envelope

    Set this.A.IPrinter = this.A.IMxApplication.Printer
    Set this.A.IPaper = this.A.IPrinter.Paper
    Set this.A.IPageLayout = this.A.IMxDocument.PageLayout
        
    Set this.A.IActiveView = this.A.IMxDocument.ActiveView
          
    Set visibleBounds = this.A.IActiveView.ScreenDisplay.ClipEnvelope

    this.A.IPageLayout.Page.GetDeviceBounds this.A.IPrinter, 1, 0, this.A.IPrinter.Resolution, deviceBounds

    deviceFrame.Left = deviceBounds.xmin
    deviceFrame.Right = deviceBounds.XMax
    deviceFrame.Top = deviceBounds.ymin
    deviceFrame.bottom = deviceBounds.YMax
    
    Set pageLayoutView = this.A.IPageLayout
    
    If (TypeOf this.A.IActiveView Is IPageLayout) Then
         Set printableBound = this.A.IPrinter.printableBounds
        this.A.IPageLayout.Page.GetPageBounds this.A.IPrinter, 0, 0, visibleBounds
    End If
    
    Set this.A.IEmfPrinter = this.A.IPrinter
    
'----------------- Offset device bounds for EMF printers only -------------

    If (TypeOf this.A.IPrinter Is IEmfPrinter) Then
        Set printableBounds = this.A.IPrinter.printableBounds
        xmin = printableBounds.xmin
        ymin = printableBounds.ymin
        XMax = printableBounds.XMax
        YMax = printableBounds.YMax
            
        deviceFrame.Left = xmin * this.A.IPrinter.Resolution
        deviceFrame.Top = ymin * this.A.IPrinter.Resolution
        deviceFrame.Right = XMax * this.A.IPrinter.Resolution
        deviceFrame.bottom = YMax * this.A.IPrinter.Resolution
    End If

'--------------------------------------------------------------------------
    
    Set visibleBounds = this.A.IActiveView.ScreenDisplay.ClipEnvelope
    
    hDC = this.A.IPrinter.StartPrinting(deviceBounds, 0)
    this.A.IActiveView.Output hDC, this.A.IPrinter.Resolution, deviceFrame, visibleBounds, Nothing
    this.A.IPrinter.FinishPrinting

End Sub

'=======================================================
'              setOrentation
'=======================================================
Private Sub setOrientation(orientation)
    
    Set this.A.IActiveView = this.A.IMxDocument.ActiveView
    Set this.A.IClone = this.A.IMxApplication.Printer
    Set this.A.IPrinter = this.A.IClone.Clone
    Set this.A.IPaper = this.A.IPrinter.Paper
    this.A.IPaper.orientation = orientation
    Set this.A.IMxApplication.Printer = this.A.IPrinter
    
    Set this.A.IPageLayout = this.A.IMxDocument.PageLayout
    this.A.IPageLayout.Page.orientation = orientation
    this.A.IActiveView.PrinterChanged this.A.IPrinter

End Sub

'=======================================================
'              setLandscape
'=======================================================
Public Sub setLandscape()

    Const landscape = 2
    setOrientation (landscape)

End Sub

'=======================================================
'              setPortrait
'=======================================================
Public Sub setPortrait()
    Const Portrait = 1
    setOrientation (Portrait)

End Sub

'=======================================================
'              ExportToJpeg
'=======================================================
Public Sub ExportToJeg(height, width, filename)
    Dim exportRECT As tagRECT
    Dim hDC As Long
    Dim scl, scalex, scaley

    Set this.A.IActiveView = this.A.IMxDocument.ActiveView
    Set this.A.IExport = New ExportJPEG

    Set this.A.IPrinter = this.A.IMxApplication.Printer
    Set this.A.IPaper = this.A.IPrinter.Paper
    Set this.A.IPageLayout = this.A.IMxDocument.PageLayout

    this.A.IExport.ExportFileName = filename
    this.A.IExport.Resolution = 1

    scalex = width / this.A.IActiveView.ScreenDisplay.ClipEnvelope.width
    scaley = height / this.A.IActiveView.ScreenDisplay.ClipEnvelope.height
    scl = scalex
    If (scaley > scl) Then scl = scaley

    exportRECT.Left = 0
    exportRECT.Top = 0
    exportRECT.Right = this.A.IActiveView.ScreenDisplay.ClipEnvelope.width * scl
    exportRECT.bottom = this.A.IActiveView.ScreenDisplay.ClipEnvelope.height * scl

    h = this.A.IActiveView.ScreenDisplay.ClipEnvelope.height * scl
    w = this.A.IActiveView.ScreenDisplay.ClipEnvelope.width * scl
    
    Set this.A.IEnvelope = New Envelope
    this.A.IEnvelope.PutCoords exportRECT.Left, exportRECT.Top, exportRECT.Right, exportRECT.bottom
    this.A.IExport.PixelBounds = this.A.IEnvelope

    hDC = this.A.IExport.StartExporting
    this.A.IActiveView.Output hDC, this.A.IExport.Resolution, exportRECT, Nothing, Nothing
    this.A.IExport.FinishExporting
    this.A.IExport.Cleanup

End Sub