| Placing PushPins using VBA programing
I have also a problem with setting pushpins with a vba code. At first I calculte a distance matrix and afterwards I want to add a pushpin to each of my addresses, but it doesnīt work...
Here is my code:
Sub Distance()
Dim oApp As New MapPoint.Application
oApp.Visible = True
oApp.UserControl = True
oApp.ActiveMap.Saved = True
oApp.Units = geoKm
Dim objFindResults As MapPoint.FindResults
Dim objLoc As MapPoint.Location
Dim objPushpin As MapPoint.Pushpin
Dim i As Integer
Dim j As Integer
Dim PLZ1, PLZ2 As String
Dim STADT1, STADT2 As String
Dim ADDRESSE1, ADDRESSE2 As String
Dim dist As Double
Set oApp = CreateObject("MapPoint.Application")
Set objMap = oApp.ActiveMap
Set objRoute = objMap.ActiveRoute
For i = 2 To 4
PLZ1 = Tabelle1.Cells(i, 2)
STADT1 = Tabelle1.Cells(i, 3)
ADDRESSE1 = Tabelle1.Cells(i, 4)
For j = i + 1 To 4
PLZ2 = Tabelle1.Cells(j, 2)
STADT2 = Tabelle1.Cells(j, 3)
ADDRESSE2 = Tabelle1.Cells(j, 4)
objRoute.Waypoints.Add objMap.FindAddressResults(PLZ1, STADT1, ADDRESSE1).Item(1)
objRoute.Waypoints.Add objMap.FindAddressResults(PLZ2, STADT2, ADDRESSE2).Item(1)
objRoute.Calculate 'Set objLoc = objMap.FindAddressResults(Plz1, stadt1, addresse1) 'objMap.AddPushpin (objLoc)
dist = objRoute.Distance
Debug.Print i & "," & j
Debug.Print "distance " & dist
objRoute.Clear
Next j
Next i
oApp.Quit
End Sub
When I run the makro without the red pushpin part everything works great. But with that part it doesnīt work. I donīt know how to add pushpins in this case but I know that the red part works in other makros...
Can anybody help me?
Already thanks
Kikolino |