how to use macro and .bas file

DennisJongsomjit

Hi,

I have some vba code (below) and a .bas file that I'm trying to add to add as an available macro tool. I've loaded the code into the normal.mxt ThisDocument page. I then loaded the .bas file into the modules folder as a new module. But when I go to Tools -> Customize -> Commands tab -> Macros the macro does not appear as a command option. Can anyone guide me here or point me to a helpful site. I had done this before successfully.... but have since gotten a new computer. The macros runs through rasters in a project and exports pngs for each one. Any help is appreciated.  What am I doing wrong?!

Thanks,

DJ

 
Private Sub ExportRFPMaps_Click()
    'MapTasks.ZoomToLayer
    'Create variables for map and extent
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    Dim pActiveView As IActiveView
    Dim pEnv As IEnvelope
    Dim strTitle As String
    
    
    'Set the current map
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap
    Set pActiveView = pMap
    
    'Loop through the RFP layers turning them on, setting the map title and exporting a .png
    'Make sure all RFP layers are off when running the tool or one layer may show up in another's view
    For i = 1 To pMap.LayerCount - 1
        If pMap.Layer(i) Is Nothing Then Exit Sub 'Test that there is a layer
        pActiveView.Extent = pMap.Layer(i).AreaOfInterest 'Set the extent to the layers extent
        Set pEnv = pActiveView.Extent 'Set the envelope object equal to the current extent
        pEnv.Expand 1.1, 1.1, True 'Expand the envelope by 10%
        pActiveView.Extent = pEnv 'Set the extent equal to the expanded envelope
        pMap.Layer(i).Visible = True 'Make current layer visible
        strTitle = MapTasks.FormatTitle(pMap.Layer(i).Name) 'Format the title into two lines
        Call MapTasks.ChangeTitle(strTitle) 'Assign the map title with the change title subc
        Call MapTasks.ExportMap("Z:\Informatics\S031\analyses\RossSeaMPA\Modeling\images\eucl_dist\" & pMap.Layer(i).Name & ".png") 'Export map with export map sub
        'Turn the layer off unless its the last layer
        If i = pMap.LayerCount - 1 Then pMap.Layer(i).Visible = True Else pMap.Layer(i).Visible = False
    Next
    
    'Let user know when its done
    MsgBox "Export Complete!  Files exported to:" & vbCrLf & "Z:\Informatics\S031\analyses\RossSeaMPA\Modeling\images\eucl_dist", vbOKOnly
    
End Sub

DennisJongsomjit

Hmm.  Thanks for the tip.  However...

I changed it to Public and that allowed me to access the macro and add it to my toolbar.  But, it's acting funny now.  I wonder if it has to do with the change from 9.2 to 9.3.1 (given that it worked before without a hitch)?

When I have one or no grids loaded the macro seemingly works correctly (get a success message) but no image is created.  It checks for layers so it's odd that it doesn't balk when there are no grids loaded.

When I have two or more grids loaded it brings up an error "Invalid procedure call or argument".

I've included the code from the .bas module I created within my normal.mxt modules folder.  Got a chance to look it over for obvious errors?  Thanks again for any help.

Public Sub ChangeTitle(txtTitle As String)
    'Create variables for map
    Dim pMxDoc As IMxDocument
    Dim pActiveView As IActiveView
    
    'Create variables for the graphics
    Dim pGraphicsContainer As IGraphicsContainer
    Dim pElement As IElement
    Dim pTextElement As ITextElement
    
    'Set the current map, layout, and graphics container
    Set pMxDoc = ThisDocument
    Set pActiveView = pMxDoc.ActiveView
    Set pPageLayout = pMxDoc.PageLayout
    Set pGraphicsContainer = pPageLayout
    Dim pMSF As IMapSurroundFrame
    Dim pMS As IMapSurround
    
    'Reset the graphics container list to return the first graphic
    'The text title is the first graphic on the page layout because it is at the top of the order
    'If you change the order of the text title the following code will not work
    pGraphicsContainer.Reset
    Set pElement = pGraphicsContainer.Next
    Set pTextElement = pElement
    pTextElement.Text = txtTitle 'This actualy changes the title.
    
    'Refresh all the map elements
    pGraphicsContainer.Reset
    Set pElement = pGraphicsContainer.Next
    Do Until pElement Is Nothing
        If TypeOf pElement Is IMapSurroundFrame Then
            Set pMSF = pElement
            Set pMS = pMSF.MapSurround
            pMS.Refresh
            pMxDoc.ActiveView.Refresh

        End If
        Set pElement = pGraphicsContainer.Next
    Loop
    
End Sub

Public Sub ExportMap(strFileName As String)
    'Create variables for map and extent
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    Dim pActiveView As IActiveView
    Dim pEnv As IEnvelope
    
    'Set the current map
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap
    Set pActiveView = pMap
    
    'Create export object and set the resolution
    Dim pExport As IExport
    Set pExport = New ExportPNG
    pExport.Resolution = 450
    
    'Set the export frame
    Dim exportRECT As tagRECT
    exportRECT = pMxDoc.ActiveView.ExportFrame

    'Set the size and extent of the export
    Dim pPixelBoundsEnv As IEnvelope
    Set pPixelBoundsEnv = New Envelope
    pPixelBoundsEnv.PutCoords exportRECT.Left, exportRECT.bottom, exportRECT.Right, exportRECT.Top
    'pPixelBoundsEnv.PutCoords 0, 2477, 4050, 0
    pExport.PixelBounds = pPixelBoundsEnv
    
    'Create a cancel object
    Dim pCancel As ITrackCancel
    Set pCancel = New CancelTracker
    
    'Set file name and export map
    pExport.ExportFileName = strFileName
    pMxDoc.ActivatedView.Output pExport.StartExporting, pExport.Resolution, exportRECT, Nothing, pCancel
    pExport.FinishExporting
    pExport.Cleanup
    
End Sub

Public Function FormatTitle(strTitle As String) As String
    Dim strFirstLine As String
    Dim strSecondLine As String
    Dim lngLength As Long
    Dim lngPosition As Long
    
    lngLength = Len(strTitle)
    lngPosition = InStr(strTitle, "Return Flow Plot")
    strFirstLine = Left(strTitle, lngPosition - 1)
    strSecondLine = Right(strTitle, lngLength - lngPosition + 1)
    
    FormatTitle = strFirstLine & vbCrLf & strSecondLine
    
End Function