XL 2016 Gestion d'erreur dans code

piga25

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
sylvanu
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 =...
Trier par date Trier par votes
sylvanu

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.
 
Vote positif 0 Vote négatif
piga25

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:
Vote positif 0 Vote négatif
sylvanu

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é.
 
Vote positif 0 Vote négatif
Solution
dysorthographie

dysorthographie

XLDnaute Accro
bonsoir,
j'ai trouvé ça que j'ai un peut modifié!
excel-downloads.com

Matrice de distances - Google Maps

Bonjour à tous ! Comme conseillé par eriiiic et d'autres, et ils n'ont pas tort, je créé mon propre topic pour partager avec vous le fichier que j'ai élaboré. Le principe est simple : lorsqu'on élabore un distancier "à la main", on doit saisir sur un site de cartographie en ligne (Google...
excel-downloads.com excel-downloads.com

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
 
Vote positif 0 Vote négatif
piga25

piga25

XLDnaute Barbatruc
dysorthographie à dit:
bonsoir,
j'ai trouvé ça que j'ai un peut modifié!
excel-downloads.com

Matrice de distances - Google Maps

Bonjour à tous ! Comme conseillé par eriiiic et d'autres, et ils n'ont pas tort, je créé mon propre topic pour partager avec vous le fichier que j'ai élaboré. Le principe est simple : lorsqu'on élabore un distancier "à la main", on doit saisir sur un site de cartographie en ligne (Google...
excel-downloads.com excel-downloads.com
Cliquez pour agrandir...
Bonsoir dysorthographie,

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

Discussions similaires

N
  • Résolu(e)
XL 2021 erreur Vba
2
Réponses
21
Affichages
986
Oneida
Oneida
L
  • Question
XL 2021 Kutools QR Code VBA
Réponses
2
Affichages
335
Backhandshot
B
yojema
  • Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
157
Dranreb
Dranreb
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
180
Francky79
F
S
  • Question
Microsoft 365 Clavier virtuel: SelectionChange, empêche la répétition
Réponses
3
Affichages
138
Simon 1234
S
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
236
halecs93
halecs93
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
235
Zonmé
Z
chaelie2015
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
226
chaelie2015
chaelie2015
M
  • Question
Microsoft 365 modifier un code
Réponses
1
Affichages
242
Dranreb
Dranreb
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
387
Messan
Messan

Membres actuellement en ligne

7 membres et 91 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 206
Messages
2 086 220
Membres
103 158
dernier inscrit
laufin