Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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

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

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

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

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

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

XLDnaute Barbatruc
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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

A
  • Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
136
patricktoulon
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
376
job75
J
  • Résolu(e)
XL 2021 Vol d'oiseau - impossible de récupérer une donnée
Réponses
11
Affichages
546
JLE
J
F
  • Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
302
Oneida
E
  • Résolu(e)
XL 2019 transfer listbox vers une colonne à partir de la 4 ligne
Réponses
2
Affichages
135
escudo
E
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
349
Gégé-45550
G
  • Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
17
Affichages
813
gali2
G
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
528
AtTheOne
T
  • Résolu(e)
XL 2019 Gestion "pseudo-évènements" sur un userform
2
Réponses
15
Affichages
529
ThierryP
T
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…