briwagner
09-25-2006, 11:19 AM
I have a project where I have an Excel workbook with several sheets. Currently each sheet has a map embeded in it. I need to be able to map data for each sheet on the correct map using VBA.
Method 1) When I try to loop through the sheets currently and link to the named range holding the address it places all of the pushpins on the map embeded on the first worksheet. I can not find a collection of maps to reference so that I can be sure I am getting the correct one.
Method 2) My other thought, which I would prefer due to the resources used by the above example, is to have one embeded map and just move it to the active sheet when you click on the tab for that sheet. Once the map is moved to the active sheet I can then link to the correct data on that sheet. The problem here is I can not get the embeded map to move from one sheet to another using VBA.
Code for method 1:
Public Sub MapIt(ws As worksheet, rcsutid as string)
Dim oMap As MapPoint.Map
Dim objPin As MapPoint.Pushpin
Dim szconn As String
Dim oDS As MapPoint.DataSet
Dim obj As OLEObject
Dim lRangeValues(1 To 3) As Variant
Dim zRangeNames(1 To 3) As String
Dim RS As MapPoint.Recordset
Dim High As Integer
Dim oDM As MapPoint.DataMap
On Error GoTo ErrorHandler
'make map interactive
ws.OLEObjects(1).Activate
'Get map
Set oMap = GetObject(, "MapPoint.Application").ActiveMap
'Clean out old datasets
For Each oDS In oMap.DataSets
oDS.Delete
Next
'Create new datasets
With oMap.DataSets
szconn = ActiveWorkbook.Path & "\JI_Dealer_Business_Plan.xls!" & ws.Name & "!location"
Set oDS = .ImportData(szconn, , geoCountryUnitedStates, , geoImportExcelNamedRange)
oDS.DisplayPushpinMap
Set RS = oDS.QueryAllRecords
RS.MoveFirst
Set objPin = RS.Pushpin
objPin.Location.Goto
oMap.ZoomIn
objPin.Symbol = 291
oDS.Name = rcustid & "Dealer Location"
szconn = ActiveWorkbook.Path & "\JI_Dealer_Business_Plan.xls!" & ws.Name & "!counties"
Set oDS = .ImportData(szconn, , geoCountryUnitedStates, , geoImportExcelNamedRange)
Set RS = oDS.QueryAllRecords
RS.MoveFirst
High = 0
Do Until RS.EOF
If High < CInt(RS.Fields("I | K | D").Value) Then
High = CInt(RS.Fields("I | K | D").Value)
End If
RS.MoveNext
Loop
lRangeValues(1) = 0
lRangeValues(3) = High
zRangeNames(1) = "Low 0"
zRangeNames(2) = "Medium " & High / 2
zRangeNames(3) = "High " & High
Set oDM = oDS.DisplayDataMap( _
geoDataMapTypeShadedArea, _
, , , geoRangeTypeContinuous, geoRangeOrderHighToLow, 13, _
, lRangeValues, zRangeNames)
oDM.LegendTitle = "Sales By County for " & rcustid
oDS.Name = "Sales By County"
End With
'Change map to Data Map
oMap.MapStyle = geoMapStyleData
'Inactivate map
ws.Range("a1").Select
GoTo Done
ErrorHandler:
MsgBox Err.Description
Done:
End Sub
Thank you,
Brian Wagner
Method 1) When I try to loop through the sheets currently and link to the named range holding the address it places all of the pushpins on the map embeded on the first worksheet. I can not find a collection of maps to reference so that I can be sure I am getting the correct one.
Method 2) My other thought, which I would prefer due to the resources used by the above example, is to have one embeded map and just move it to the active sheet when you click on the tab for that sheet. Once the map is moved to the active sheet I can then link to the correct data on that sheet. The problem here is I can not get the embeded map to move from one sheet to another using VBA.
Code for method 1:
Public Sub MapIt(ws As worksheet, rcsutid as string)
Dim oMap As MapPoint.Map
Dim objPin As MapPoint.Pushpin
Dim szconn As String
Dim oDS As MapPoint.DataSet
Dim obj As OLEObject
Dim lRangeValues(1 To 3) As Variant
Dim zRangeNames(1 To 3) As String
Dim RS As MapPoint.Recordset
Dim High As Integer
Dim oDM As MapPoint.DataMap
On Error GoTo ErrorHandler
'make map interactive
ws.OLEObjects(1).Activate
'Get map
Set oMap = GetObject(, "MapPoint.Application").ActiveMap
'Clean out old datasets
For Each oDS In oMap.DataSets
oDS.Delete
Next
'Create new datasets
With oMap.DataSets
szconn = ActiveWorkbook.Path & "\JI_Dealer_Business_Plan.xls!" & ws.Name & "!location"
Set oDS = .ImportData(szconn, , geoCountryUnitedStates, , geoImportExcelNamedRange)
oDS.DisplayPushpinMap
Set RS = oDS.QueryAllRecords
RS.MoveFirst
Set objPin = RS.Pushpin
objPin.Location.Goto
oMap.ZoomIn
objPin.Symbol = 291
oDS.Name = rcustid & "Dealer Location"
szconn = ActiveWorkbook.Path & "\JI_Dealer_Business_Plan.xls!" & ws.Name & "!counties"
Set oDS = .ImportData(szconn, , geoCountryUnitedStates, , geoImportExcelNamedRange)
Set RS = oDS.QueryAllRecords
RS.MoveFirst
High = 0
Do Until RS.EOF
If High < CInt(RS.Fields("I | K | D").Value) Then
High = CInt(RS.Fields("I | K | D").Value)
End If
RS.MoveNext
Loop
lRangeValues(1) = 0
lRangeValues(3) = High
zRangeNames(1) = "Low 0"
zRangeNames(2) = "Medium " & High / 2
zRangeNames(3) = "High " & High
Set oDM = oDS.DisplayDataMap( _
geoDataMapTypeShadedArea, _
, , , geoRangeTypeContinuous, geoRangeOrderHighToLow, 13, _
, lRangeValues, zRangeNames)
oDM.LegendTitle = "Sales By County for " & rcustid
oDS.Name = "Sales By County"
End With
'Change map to Data Map
oMap.MapStyle = geoMapStyleData
'Inactivate map
ws.Range("a1").Select
GoTo Done
ErrorHandler:
MsgBox Err.Description
Done:
End Sub
Thank you,
Brian Wagner