XL 2016 Gestion d'erreur dans code

piga25

XLDnaute Barbatruc
Bonjour,
J'ai un code qui fonctionne très bien pour calculer des distances entre deux villes, sauf lorsque l'on fait une faute dans le nom ou qu'il existe plusieurs possibilités (dans ce dernier cas, il faut ajouter le nom du département et cela fonctionne bien).
Ce que je souhaiterai avoir, c'est une gestion d'erreur qui me signale qu'il faut corriger et ajouter le nom du département dans la TextBox destination dans mon Userform.
Userform : frmNotedeFrais
TxtBox : txtVilleArrivee

Est-ce dans ce code là qu'il faut intégrer la gestion d'erreur ou ailleurs.

VB:
Sub CalculeDistance()

    'Déclaration des variables
    Dim URL As String, Txt As String
    Dim VilleDepart As String, VilleDestination As String
 
   On Error GoTo monErreur:
 
    'Affectation des variables
    VilleDepart = Range("AD4")
    VilleDestination = Range("AD5")

    'Avec la feuille active
    With ActiveSheet
        'Construction du lien URL du site Distance2villes.com
        URL = DIST & VilleDepart & "&destination=" & VilleDestination
        With CreateObject("WINHTTP.WinHTTPRequest.5.1")
            .Open "GET", URL, False     'Si HTTP, la propriété de l'Open est GET, envoie la requête sans Body
            .Send                       '
            Txt = .responseText
        End With
        Range("AD6") = Split(Split(Txt, "id=""distanciaRuta"">")(1), "</strong>")(0)
    End With
 
monErreur:
    MsgBox "Ajouter le nom du département ex: Ville, département"
    Exit Sub
   
 
End Sub

Ou dans celui-ci
VB:
Sub OuvreFormulaire()

    Dim Reponse As Integer
    Reponse = MsgBox("Désirez-vous compléter une nouvelle Note de Frais mensuelle ?", vbYesNo, "SAISIE NOTE DE FRAIS")
    If Reponse = vbYes Then
  
  
        With ActiveSheet
      
        If MsgBox("Etes-vous certain de vouloir supprimer le tableau ?", vbYesNo, "Demande de confirmation") = vbYes Then
        Range("C10").ClearContents
        .Range("B13:G30").ClearContents
        MsgBox "Le contenu du tableau a été effacé !"
    End If
      
            '.Range("C10").ClearContents
            '.Range("B13:F30").ClearContents
        End With
        frmNotedeFrais.Show
    Else
        frmNotedeFrais.Show
        'Exit Sub
    End If
  
End Sub

Ou alors dans le code de l'userform
code du bouton valider:
VB:
Private Sub btnValider_Click()
               
    'Appel de la procédure qui calcule la distance entre deux villes
    Call CalculeDistance
    'On récupère la dernière ligne vide de la Note de Frais
    Range("B31").End(xlUp).Offset(1, 0).Select
    'On teste que la date a été saisie
    If Me.txtDate <> "" Then
        ActiveCell = CDate(Me.txtDate) 'Format Date
    Else
        lblMessage = "Vous n'avez pas saisie la date du trajet"
    End If
    'On affiche les infos dans la note de frais
    ActiveCell.Offset(0, 1) = Me.txtVilleDepart
    ActiveCell.Offset(0, 2) = Me.txtVilleArrivee
    ActiveCell.Offset(0, 3) = Me.txtClient
    ActiveCell.Offset(0, 4) = Range("AD7")
    ActiveCell.Offset(0, 5) = Me.TxtPeage
   
End Sub
 
Solution
Re,
Un moyen simple est de créer une variable publique ( visible de tous les modules ), elle est initialisée à 0.
En cas d'erreur on met cette variable à 1.
Dans btnValider_Click après l'appel à CalculeDistance, on regarde cette variable. Si elle vaut 1 on sort.
VB:
Public Erreur ' Erreur=1 si erreur sinon 0
Sub CalculeDistance()
    'Déclaration des variables
    Dim URL As String, Txt As String
    Dim VilleDepart As String, VilleDestination As String
    ' Init pas erreur
    Erreur = 0
   On Error GoTo monErreur:
    'Affectation des variables
    VilleDepart = Range("AD4")
    VilleDestination = Range("AD5")
    'Avec la feuille active
    With ActiveSheet
        'Construction du lien URL du site Distance2villes.com
        URL =...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Piga,
Je pense que dans la macro CalculeDistance le code passe toujours par le msgbox qu'il y ait erreur ou non.
Je pense qu'au lieu de mettre :
VB:
monErreur:
    MsgBox "Ajouter le nom du département ex: Ville, département"
    Exit Sub
 
End Sub
il vaut mieux mettre :
Code:
Exit Sub
monErreur:
    MsgBox "Ajouter le nom du département ex: Ville, département"
End Sub
De cette façon, sans erreur on sort sans message, avec erreur on a le message.
 

piga25

XLDnaute Barbatruc
Bonsoir Sylvanu

En effet le msgbox ne s'affiche que s'il y a une erreur lorsque Exit Sub en placé avant.

Néanmoins j'ai un autre problème, cela n'arrête pas le code car les données (les anciennes) sont inscrites dans le tableau de réception.

Edit: seulement si on reclique sur le bouton déclenchant : btnValider_Click()

L'idéal serait de remettre à blanc la txtVilleArrivee de l'userform car j'ai une condition qui arrête le code si cette txtbox est vide

VB:
Private Sub btnValider_Click()
    ' arrêt de la procèdure si ville arrivée est vide
     If Me.txtVilleArrivee = "" Then
        Exit Sub
    End If
   
    'Appel de la procédure qui calcule la distance entre deux villes
    Call CalculeDistance
   
    'On récupère la dernière ligne vide de la Note de Frais
    Range("B31").End(xlUp).Offset(1, 0).Select
    'On teste que la date a été saisie
    If Me.txtDate <> "" Then
        ActiveCell = CDate(Me.txtDate) 'Format Date
    Else
        lblMessage = "Vous n'avez pas saisie la date du trajet"
    End If

    'On affiche les infos dans la note de frais
    ActiveCell.Offset(0, 1) = Me.txtVilleDepart
    ActiveCell.Offset(0, 2) = Me.txtVilleArrivee
    ActiveCell.Offset(0, 3) = Me.txtClient
    ActiveCell.Offset(0, 4) = Range("AD7")
    ActiveCell.Offset(0, 5) = Me.TxtPeage
   
End Sub
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Un moyen simple est de créer une variable publique ( visible de tous les modules ), elle est initialisée à 0.
En cas d'erreur on met cette variable à 1.
Dans btnValider_Click après l'appel à CalculeDistance, on regarde cette variable. Si elle vaut 1 on sort.
VB:
Public Erreur ' Erreur=1 si erreur sinon 0
Sub CalculeDistance()
    'Déclaration des variables
    Dim URL As String, Txt As String
    Dim VilleDepart As String, VilleDestination As String
    ' Init pas erreur
    Erreur = 0
   On Error GoTo monErreur:
    'Affectation des variables
    VilleDepart = Range("AD4")
    VilleDestination = Range("AD5")
    'Avec la feuille active
    With ActiveSheet
        'Construction du lien URL du site Distance2villes.com
        URL = DIST & VilleDepart & "&destination=" & VilleDestination
        With CreateObject("WINHTTP.WinHTTPRequest.5.1")
            .Open "GET", URL, False     'Si HTTP, la propriété de l'Open est GET, envoie la requête sans Body
            .Send                       '
            Txt = .responseText
        End With
        Range("AD6") = Split(Split(Txt, "id=""distanciaRuta"">")(1), "</strong>")(0)
    End With
Exit Sub
monErreur:
    Erreur = 1 ' car erreur détectée
    MsgBox "Ajouter le nom du département ex: Ville, département"
End Sub

Private Sub btnValider_Click()
    'Appel de la procédure qui calcule la distance entre deux villes
    Call CalculeDistance
    ' On sort si erreur détectée dans CalculeDistance
    If Erreur = 1 Then Exit Sub
    'On récupère la dernière ligne vide de la Note de Frais
    Range("B31").End(xlUp).Offset(1, 0).Select
    'On teste que la date a été saisie
    If Me.txtDate <> "" Then
        ActiveCell = CDate(Me.txtDate) 'Format Date
    Else
        lblMessage = "Vous n'avez pas saisie la date du trajet"
    End If
    'On affiche les infos dans la note de frais
    ActiveCell.Offset(0, 1) = Me.txtVilleDepart
    ActiveCell.Offset(0, 2) = Me.txtVilleArrivee
    ActiveCell.Offset(0, 3) = Me.txtClient
    ActiveCell.Offset(0, 4) = Range("AD7")
    ActiveCell.Offset(0, 5) = Me.TxtPeage
End Sub
Mais sans fichier test, ça n'a pas été testé.
 

dysorthographie

XLDnaute Accro
bonsoir,
j'ai trouvé ça que j'ai un peut modifié!

VB:
Type MAP
    Dist As Double
    Unite As String
    Temp As Date
End Type

Function Distance(Depart As String, Arrivee As String) As MAP
Const Dist = "http://www.distance2villes.com/recherche?source="
 url = Dist & Depart & "&destination=" & Arrivee
            With CreateObject("WINHTTP.WinHTTPRequest.5.1")
                .Open "GET", url, False
                .send
                Txt = .responseText
            End With
            If InStr(1, Txt, "distanciaRuta") > 0 Then
               Distance.Dist = Val(Split(Split(Txt, "id=""distanciaRuta"">")(1), "</strong>")(0))
               Distance.Unite = Split(Split(Split(Txt, "id=""distanciaRuta"">")(1), "</strong>")(0))(1)
               Distance.Temp = Replace(Replace(Split(Split(Txt, """tiempo"">")(1), "</")(0), " heures ", ":"), " mins", "")
            Else
                Distance.Dist = -1
                Distance.Temp = "0:0:0"
                Distance.Unite = "Pas de réponse"
            End If
End Function

Sub Main()
Dim Depart As String, Arrivee As String

Depart = "Lyon"
Arrivee = "paris"
With Distance(Depart, Arrivee)
    If .Dist = -1 Then
        If MsgBox("Voulez vous affiner la recherche", vbYesNo + vbQuestion) = vbYes Then MsgBox "Ouvrir Formulaire"
    Else
    Debug.Print .Dist, .Unite, .Temp
    End If
End With
End Sub
 

piga25

XLDnaute Barbatruc
bonsoir,
j'ai trouvé ça que j'ai un peut modifié!
Bonsoir dysorthographie,

Je regarde cela car avoir une fonction pour calculer les distances m'intéresse.
Merci pour ce partage.
 

Discussions similaires

Réponses
21
Affichages
1 K

Statistiques des forums

Discussions
312 935
Messages
2 093 738
Membres
105 805
dernier inscrit
belgacem.nahali