Bonjour
J'utilise un code posté par compress :
Excel 2003 Calcul de distance automatique avec MapPoint
J'ai bien recopié ce code et référencé Microsoft MapPoint 16.0 Object Library (Europe) mais j'ai malheureusement un code erreur 1004 "Erreur définie par l'application ou par l'objet" Et je n'arrive pas à résoudre ce problème.....
Quelqu'un pourrait-il m'aider ?
Merci d'avance à toutes et à tous !
J'utilise un code posté par compress :
Excel 2003 Calcul de distance automatique avec MapPoint
J'ai bien recopié ce code et référencé Microsoft MapPoint 16.0 Object Library (Europe) mais j'ai malheureusement un code erreur 1004 "Erreur définie par l'application ou par l'objet" Et je n'arrive pas à résoudre ce problème.....
Quelqu'un pourrait-il m'aider ?
Merci d'avance à toutes et à tous !
PHP:
[QUOTE]Private Sub Distance()
Dim objApp As New MapPoint.Application
Dim objMap As MapPoint.Map
Dim objRoute As MapPoint.Route
Dim objLoc1 As MapPoint.Location
Dim objLoc2 As MapPoint.Location
Set objApp = CreateObject("MapPoint.Application.EU.16")
objApp.Visible = False
Set objMap = objApp.NewMap
Set objRoute = objMap.ActiveRoute
Worksheets("Feuil1").Cells(1, 7).Value = "Dist routière (kms)"
Worksheets("Feuil1").Cells(1, 8).Value = "Dist oiseau (kms)"
LigneActive = 2
Do While Worksheets("Feuil1").Cells(NReadRow, 2) <> ""
'Définition des deux points sur la carte
Set objLoc1 = objMap.FindResults(Worksheets("Feuil1").Cells(LigneActive, 2)).Item(1)
Set objLoc2 = objMap.FindResults(Worksheets("Feuil1").Cells(LigneActive, 6)).Item(1)
'Placement des points et calcul de la distance
objRoute.Waypoints.Add objLoc1
objRoute.Waypoints.Add objLoc2
objRoute.Calculate
'Distance routière entre les deux villes
Worksheets("Feuil1").Cells(LigneActive, 7) = objRoute.Distance
'Distance à vol d'oiseau
Worksheets("Feuil1").Cells(LigneActive, 8) = objMap.Distance(objLoc1, objLoc2)
objRoute.Clear
LigneActive = LigneActive + 1
Loop
objMap.Saved = True
Set objApp = Nothing
Set objMap = Nothing
Set objLoc1 = Nothing
Set objLoc2 = Nothing
Set objRoute = Nothing
End Sub[/QUOTE]