I do not claim to be a very good VB, or VBA, programmer. However, from my earlier Fortran and Pascal days I’m usually able to mess around with VBA to accomplish what I need done. I still struggle correctly assigning all of the object variables though.

I am encountering a problem using the ZoomTo method. I have developed a VBA application in MS Access 2000 to take one of our contracted area’s zip codes then automatically generate and print a territory map for their contract. The territory is outlined and the zip codes contracted are highlighted in white. The other zip codes remain grayed out.

Roughly 80% of the time, the application works great. However, every now and then, a territory is cropped as a result of the ZoomTo method. When this occurs, it only slightly vertically crops the territory information. Has anyone else experienced this? If so, have you been successful creating a workaround?

I created a workaround that, unfortunately, only works sometimes. I added this to the “Get the MapPoint map ready to print” section of my code.
'Workaround for Zoom Cropping Bug
appMapPoint.PaneState = geoPaneLegend
appMapPoint.Visible = True
objTerritory.ZoomTo
appMapPoint.WindowState = geoWindowStateMaximize
appMapPoint.Visible = False

The table ExhibitB that contains the information to map contains the following fields:
ZIP (text, field size 10)
TerritoryID (text, field size 50)
ContractID (text, field size 50).

I cannot understand why the code does not always work, although territories that have a low aspect ratio tend to be the problem ones. I'm not sure how to attach some examples of problematic data.

Here is the main VBA code:

Option Compare Database
Option Base 1


Public Function AutoPrintMap()

'------------------------------------------------------------------------
'This function automatically generates a map for the zip codes
'and the territory outlined in the MS Access table named ExhibitB.
'This function is written to be called from within the same database
'as ExhibitB.

'------------------------------------------------------------------------
'Open the table ExhibitB for use and read out the Territory Name

Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strTerritory As String

Set cnn = CurrentProject.Connection
rst.Open "ExhibitB", cnn, adOpenKeyset, adLockOptimistic

rst.MoveFirst 'The Territory Name is the same for all records
strTerritory = rst!ContractRep

'------------------------------------------------------------------------
'Programmatically launch MapPoint

Dim appMapPoint As MapPoint.Application
Dim objActiveMap As MapPoint.Map

Set appMapPoint = CreateObject("MapPoint.Application")
appMapPoint.Visible = False 'Set to False if the application does not
'need to actually "see" the map.
Set objActiveMap = appMapPoint.ActiveMap

'------------------------------------------------------------------------
'Use the variable strDataSourceMoniker to reference the table named
'ExhibitB in this MS Access Database

Dim strDataSourceMoniker As String
Dim strPath As String

strPath = CurrentProject.Path & "\" & CurrentProject.Name
strDataSourceMoniker = strPath & "!ExhibitB"

'------------------------------------------------------------------------
'Set up array for "ArrayofFields" variable used to import territories
'Into MapPoint. The field ZIP in the Exhibit B Table will be used as
'the mapping field. The field Territory in the Exhibit B Table will be
'used as the Territory Name.
'
' ^
'/!\ IMPORTANT NOTE: Option Base 1 must be specified globally!!!!!
'---
Dim arrTerritory(2, 2) As Variant

arrTerritory(1, 1) = "ZIP"
arrTerritory(1, 2) = geoFieldPostal1
arrTerritory(2, 1) = "ContractRep"
arrTerritory(2, 2) = geoFieldTerritory

'------------------------------------------------------------------------
'Programmatically draw the territory on the MapPoint map

Dim objTerritory As MapPoint.DataSet

With objActiveMap.DataSets
Set objTerritory = _
.ImportTerritories(strDataSourceMoniker, arrTerritory, _
geoCountryUnitedStates, geoDelimiterDefault, geoImportAccessTable)
End With
'------------------------------------------------------------------------
'Set up array for "ArrayofFields" variable used to import Zip Codes
'Into MapPoint. The field ZIP in the Exhibit B Table will be used as
'the mapping field. The field Territory in the Exhibit B Table will be
'used as the data to map field.
'
' ^
'/!\ IMPORTANT NOTE: Option Base 1 must be specified globally!!!!!
'---
Dim arrZipCodes(2, 2) As Variant

arrZipCodes(1, 1) = "ZIP"
arrZipCodes(1, 2) = geoFieldPostal1
arrZipCodes(2, 1) = "ContractRep"
arrZipCodes(2, 2) = geoFieldData

'------------------------------------------------------------------------
'Programmatically draw the zip codes on the MapPoint map

'First input the zip codes as a MapPoint DataSet
Dim objZipData As MapPoint.DataSet

With objActiveMap.DataSets
Set objZipData = _
.ImportData(strDataSourceMoniker, arrZipCodes, _
geoCountryUnitedStates, geoDelimiterDefault, geoImportAccessTable)
End With

'Then draw the DataSet on the map
Dim objDataMap As MapPoint.DataMap
Dim objField As MapPoint.Field

'Set up this array so the zip codes are highlighted in the color White
Dim arrDataRange(2) As Variant
arrDataRange(1) = 0
arrDataRange(2) = strTerritory

Set objField = objZipData.Fields("ContractRep")
Set objDataMap = _
objZipData.DisplayDataMap(geoDataMapTypeShadedArea , objField, _
geoShowByPostal1, geoCombineByNone, geoRangeTypeDefault, _
geoRangeOrderDefault, 7, 2, arrDataRange)


'------------------------------------------------------------------------
'Get the MapPoint map ready to print

'Remove roads from printing
objActiveMap.MapStyle = geoMapStyleData

'Size the map around the territory of interest
objTerritory.ZoomTo


'------------------------------------------------------------------------
'Automatically print the map
'Remove the comment " ' " in the
'following comment line to disable this automatic printout
'GoTo Skip_PrintOut
Dim strTitle As String
strTitle = "This map is provided for illustrative purposes " & _
"only. Refer to Exhibit B for official contracted territory."

objActiveMap.PrintOut Title:=strTitle, _
PrintOrientation:=geoPrintLandscape

Skip_PrintOut:

'------------------------------------------------------------------------
'Close connection to ExhibitB Table
cnn.Close

'------------------------------------------------------------------------
'Skip the "Save As" menu generated by MapPoint

appMapPoint.ActiveMap.Saved = True

End Function

It is amazing what one can find when the entire programming reference help file is printed !

The workaround is:

objActiveMap.Altitude = objActiveMap.Altitude*1.2

I hope someone else finds this information useful. It took several months and many manual fixes before we finally found it.

Jeff

Thanks, I had to deal with the same zoomto bug. But I lived with it. Now I have a solution.