[VBA] Gestion d'erreur

Anthonymctm

XLDnaute Occasionnel
Bonjour Le forum,

J'ai créer une petite macro pour me faciliter la vie et indicer mes devis. :cool:

Une input box me propose le prochain indice de devis en se basant sur le nom du fichier normalement de la forme DXX-XXXX-XX.
Ensuite je fais une vérification que la saisie respecte bien le format.

L'erreur que j'ai sera générée à la ligne 7 si le nom du fichier ne se prete pas à l'addition +1 ou au format "00".
Ce que j'aurai voulu c'est proposer une autre version de nDevis= en cas d'erreur.
Mais je ne sais pas comment faire (première fois que je fais de la gestion d'erreur), j'ai vu quelque tuto mais j'ai pas un cas comme ça. o_O
Je voudrais réglé ce nDevis différement mais uniquement en cas d’erreur, puis reprendre à la ligne 8 (après la ligne à problème)

VB:
Sub Indicer()
Dim nDevis As String
Dim FirstWord, LastWord, MidWord

On Error GoTo mauvaisTitre

nDevis = Application.InputBox("Saisir le n° devis (n° actuel : " & Left(ThisWorkbook.Name, 11) & ")" & vbCrLf & "Le fichier actuel ne sera pas enregistré." & vbCrLf & "Pensez à enregistrer avant de valider", , Left(ThisWorkbook.Name, 9) & Format(Mid(ThisWorkbook.Name, 10, 2) + 1, "00"), Type:=2)
If nDevis = "Faux" Then
MsgBox "Indiçage annulé"
Exit Sub
End If
 
FirstWord = Mid(nDevis, 1, 4)    ' Returns "DXX-"
MidWord = Mid(nDevis, 5, 4)    ' Returns "XXXX"
LastWord = Mid(nDevis, 9)    ' Returns "-XX"

 If FirstWord Like "D[0-9][0-9]-" And MidWord Like "[0-9][0-9][0-9][0-9]" And LastWord Like "-[0-9][0-9]" Then

 ActiveWorkbook.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & nDevis
 MsgBox "Devis indicé"
 
Else: MsgBox "Erreur de syntaxe dans le n° de devis"
Indicer
End If
End Sub
 
Solution
Re Bonsoir @Anthonymctm , Patrick, @jmfmarques le Forum

L'avantage avec le VBA c'est son extrême souplesse et flexibilité, les GoTo datent du Basic (Pas du Visual Basic) à l'époque (pour les anciens) c'est comme ça que l'on programmait en numérotant les lignes de codes... Très lourds et surtout ça devient rapidement illisible et incompréhensible...

En Gestion d'erreur avec étiquette: c'est assez courant d'usage, par contre, en pure programmation c'est à éviter car VBA propose des moyens bien plus puissants et sans équivoque sans avoir un Algo qui "rebondit" dans tous les sens quand on fait du Pas à Pas (Touche F8) .... Ca rebondit déjà bien trop sans GoTo

Maintenant comme je disais pour les avantages c'est que VBA...

Anthonymctm

XLDnaute Occasionnel
re
ok je ne connais pas la raison de la réindexation mais bon
mon truc ne fera jamais d'erreur d'indexation lors du l enregistrement
perso des documents indexé et ré indexé ça sent pas bon
Oui je comprend bien et je partage ton point de vue !
C'est juste que dans ma boite si on a un devis proche d'un autre on va préféré repartir d'un ancien plutot qu'en refaire un nouveau, quitte a avoir des erreurs parfois.
Ya aussi des fois ou on va faire un devis autrement (par exemple direct sur word, sans passer par le fichier excel). Ou même à l'oral ou dans un mail parfois. C'est pour ça que j'ai besoin de cette souplesse.
 

patricktoulon

XLDnaute Barbatruc
d'accords
pour que je comprenne dis moi si je me trompe
tu ouvre un devis (un ancien)
avec ton inputbox et tout ton toin toin tu souhaite re sauver ce même devis après avoir fait quelque modif avec l'index +1

sauf que!!!!!
  1. si le devis que tu copie a été suivi de 36 autres ben ton index+1 walouh!!! walouh !!!!
  2. ça implique qu'il faut du vba dans chaque devis (inacceptable conceptuellement)
  3. ca implique que après test échoué du +1 il faille aller chercher le bon index avec une boucle dir (comme je le fait dès départ )
j’arrête là la liste des défauts car il y en a bien d'autre dans ta conception

conclusion nous n'avons pas a même définition de la souplesse
je suis étonné que le responsable accepte cela par ce que c' est LE DEFAUT N° 1 je dirais ;) :D :rolleyes:

et je dis cela hors contexte vba , il s'agit là de regles élémentaires de tenue de dossier en intégrité totale


rien empêche cela dit et !!!!dans les règles de l'art ,d'avoir:
  1. un model devis vierge(celui toujours utilisé)
  2. avec un bouton donnant la possibilité de copier le contenu d'un ancien (je dis bien copier le contenu et non le fichier )
  3. utiliser mon model précédemment donné (plus haut dans la discussion)pour enregistrer
voila ma conception de la souplesse ;)
A méditer
 

Anthonymctm

XLDnaute Occasionnel
ça implique qu'il faut du vba dans chaque devis (inacceptable conceptuellement)
Pourquoi c'est inacceptable ? Dans son fonctionnement mon fichier devis a plein de macro et de vba.

tu ouvre un devis (un ancien)
avec ton inputbox et tout ton toin toin tu souhaite re sauver ce même devis après avoir fait quelque modif avec l'index +1
En fait je le sauve avant d'avoir fait les modifs (sinon elles ne seront pas enregistrées)

Ci-joint ma macro pour l'indiçage / renommage
VB:
Sub Indicer()
Dim nDevis As String
Dim FirstWord As String, LastWord As String, MidWord As String
Dim Sauvegarde As Variant, Question As Integer

If ThisWorkbook.Name Like "D##-####-##" & ".xlsm" Then
nDevis = InputBox("Saisir le n° devis (n° actuel : " & Left(ThisWorkbook.Name, 11) & ")" & vbCrLf & "Le fichier actuel ne sera pas enregistré." & vbCrLf & "Pensez à enregistrer avant de valider", , Left(ThisWorkbook.Name, 9) & Format(Mid(ThisWorkbook.Name, 10, 2) + 1, "00"))

Else:
nDevis = InputBox("Saisir le n° devis (D" & Right(Year(Now), 2) & "-XXXX-XX)" & vbCrLf & "Le fichier actuel ne sera pas enregistré." & vbCrLf & "Pensez à enregistrer avant de valider", , ThisWorkbook.Name)

End If

If nDevis = "" Then 'si on clique sur annulé
GoTo msg2

End If

FirstWord = Mid(nDevis, 1, 4)    ' Returns "DXX-"
MidWord = Mid(nDevis, 5, 4)    ' Returns "XXXX"
LastWord = Mid(nDevis, 9)    ' Returns "-XX"

If FirstWord Like "D[0-9][0-9]-" And MidWord Like "[0-9][0-9][0-9][0-9]" And LastWord Like "-[0-9][0-9]" Then

ActiveWorkbook.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & nDevis
MsgBox "Devis indicé"

Else
msg2:
Msg = "Votre n° doit être de la forme : D" & Right(Year(Now), 2) & "-XXXX-XX" & vbCrLf & vbCrLf & "Réessayer      Enregistrer sous" & vbCrLf & "    |                               |" & vbCrLf & "   \/                              \/"
Style = vbYesNoCancel + vbExclamation + vbDefaultButton1
Title = "Erreur dans le numéro de devis"
Help = "DEMO.HLP"
Ctxt = 1000

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

    If Response = vbYes Then
    Indicer
    ElseIf Response = vbNo Then ' Demande ou sauver le doc et le nom à lui donner
        If nDevis = "" Then
            If ThisWorkbook.Name Like "D##-####-##" & ".xlsm" Then
            nDevis = Left(ThisWorkbook.Name, 9) & Format(Mid(ThisWorkbook.Name, 10, 2) + 1, "00")
            Else: nDevis = ThisWorkbook.Name
            End If
            End If
       Sauvegarde = Application.GetSaveAsFilename(ActiveWorkbook.Path & "\" & nDevis & ".xlsm", FileFilter:="XLSM (*.xlsm), *.xlsm", Title:="Enregistrer-sous ...")
   
        If Sauvegarde = False Then GoTo msg2 ' Si click sur annuler, alors on revient a la boite de dialoque

        If Dir(Sauvegarde) <> "" Then ' le fichier renseigné par l'utilisateur existe-t-il ?
        Question = MsgBox("Attention le fichier existe déjà" & Chr(13) & "Voulez vous le remplacer ?", vbQuestion + vbYesNo, "Attention...")
             ' Si oui, faut t-il l'effacer ?
            If Question = 6 Then ' Oui
              Kill Sauvegarde ' Efface
            Else ' Non
             GoTo msg2 ' On revient a la boite de dialoque
            End If
     
         End If
ThisWorkbook.SaveAs Sauvegarde ' Sauvegarde
  Else: MsgBox "Indiçage annulé" 'si on clique sur annulé
  End If
 
End If

End Sub

J'ai testé tous les cas de figure et tout fonctionne correctement, j'ai du mal à comprendre ce qui va pas dans ma conception :rolleyes:

je suis étonné que le responsable accepte cela par ce que c' est LE DEFAUT N° 1 je dirais
Le responsable de ça c'est moi donc ça va, je l'accepte :rolleyes:
Plus sérieusement, c'est de quel défaut dont tu parles ?

  1. un model devis vierge(celui toujours utilisé)
  2. avec un bouton donnant la possibilité de copier le contenu d'un ancien (je dis bien copier le contenu et non le fichier )
  3. utiliser mon model précédemment donné (plus haut dans la discussion)pour enregistrer
C'est justement comme ça que je compte faire, laisser aux commerciaux le fichier vierge en tant que modèle et ensuite il se le récupère, à l'ouverture le fichier detecte qu'il est le fichier vierge et propose donc à peu près la fonctionnalité pour saisir un nom de fichier ou un enregistrer sous.


Le seul cas qui amène à une erreur dans ma macro Indicer est le cas ou dans le premier input box je saisie un code qui existe déjà, alors il me demande si je veux l'ecraser et là, si je refuse ou que j'annule j'ai une erreur. (ce cas là est prévu quand je passe par l'enregistrer sous au deuxième msgbox.
 
Dernière édition:

_Thierry

XLDnaute Barbatruc
Repose en paix
Re Bonjour
Sans me méler du pour ou contre "liberté" de l'inputbox...

Le seul cas qui amène à une erreur dans ma macro Indicer est le cas ou dans le premier input box je saisie un code qui existe déjà, alors il me demande si je veux l'ecraser et là, si je refuse ou que j'annule j'ai une erreur.

Dans mon précédent exemple, je t'avais montré cette gestion d'erreur, il me semble ?
Et je ne vois pas la suggestion de simplification proposée par JmfMarques

Bien à toi, à vous
@+Thierry
 

patricktoulon

XLDnaute Barbatruc
re
voici une maquete de fichier model
tu a 3 boutons
nouveau devis
enregistrer
ouvrir ancien devis
et va y amuse toi a jongler entre la creation de nouveau et copie d'ancien modifiés
j'ai fait ca en quelque minutes juste pour te montrer le principe d’enregistrement de fichier indexé
la seul boite de dialogue que tu a c'est pour choisir un ancien devis comme model

en avant gringuant
crée en quelques un avant de tenter d'en copier un
 

Pièces jointes

  • model devis.xlsm
    30.2 KB · Affichages: 7

Anthonymctm

XLDnaute Occasionnel
Et je ne vois pas la suggestion de simplification proposée par JmfMarques
Alors son
If ThisWorkbook.Name Like "D##-####-##" & ".xlsm" Then est présent au tout début de mon code :)
Dans mon précédent exemple, je t'avais montré cette gestion d'erreur, il me semble ?
J'avais testé mais je n'étais pas parvenu à insérer ton code au bon endroit :confused:
Mais ya des chances pour que ce soit la sollution que je cherche, je vais creuser
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Re @Anthonymctm , Patrick

Ah oui en effet le conseil de JMF est bien là, mais donc cette partie là est inutile et surcharge le code du coup :
FirstWord = Mid(nDevis, 1, 4) ' Returns "DXX-" MidWord = Mid(nDevis, 5, 4) ' Returns "XXXX" LastWord = Mid(nDevis, 9) ' Returns "-XX" If FirstWord Like "D[0-9][0-9]-" And MidWord Like "[0-9][0-9][0-9][0-9]" And LastWord Like "-[0-9][0-9]" Then

Pour la gestion de l'erreur 1004 c'est avant ceci :
ActiveWorkbook.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & nDevis
Là exactement :
VB:
    On Error GoTo ErrorHandler 'Voir Label ErrorHandler:
     ActiveWorkbook.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & nDevis
    On Error GoTo 0            'On anulle le on error

@+Thierry
 

Anthonymctm

XLDnaute Occasionnel
re
voici une maquete de fichier model
tu a 3 boutons
nouveau devis
enregistrer
ouvrir ancien devis
et va y amuse toi a jongler entre la creation de nouveau et copie d'ancien modifiés
j'ai fait ca en quelque minutes juste pour te montrer le principe d’enregistrement de fichier indexé
la seul boite de dialogue que tu a c'est pour choisir un ancien devis comme model

en avant gringuant
crée en quelques un avant de tenter d'en copier un
Je te remercie pour ton fichier, je vais me le garder dans un coin pour la fonction d'ouverture qui a l'aire interessante.

Pour ce qui est du nouveau c'est pas applicable dans mon cas, j'ai trop d'onglets et trop de macros.
Le meilleur moyen d'en faire un nouveau c'est de partir du vierge (que je met à jour régulièrement sur notre serveur)
Et pour le enregistrer je persiste que si j'ai pas la possibilité de renseigner manuellement mon code à un moment ou un autre ça va compliqué la tache. Les utilisateurs devront renommer en permanence leur fichier. Sans compter que je reste en train de modifier le fichier original et ça fait partie des chose que je cherche à éviter grâce au SaveAs
 

patricktoulon

XLDnaute Barbatruc
allez avec un peu moins de fainéantise on recupere les valeurs de l'ancien devis avec des formules de liaison écrasées ensuite par la valeur

VB:
Private Sub CommandButton2_Click()
    Dim filetoopen As Variant, dossier$, nom$, cel As Range, formule$
    ChDir ThisWorkbook.Path
    filetoopen = Application.GetOpenFilename("Devis Files (*.xlsx), *.xlsx", 1, "ouvrir un Devis existant")
    If filetoopen = False Then Exit Sub
    nom = Mid(filetoopen, InStrRev(filetoopen, "\") + 1)
    dossier = Mid(filetoopen, 1, InStrRev(filetoopen, "\"))
    With .Sheets(1).Range("D2,D5:E5,D6:E6,D7:E7,D8:E8,A12:D22")
        'copie des donnée de l'ancien par des formules de liaison
        For Each cel In .Cells
            formule = "='" & dossier & "[" & nom & "]Feuil1'!" & cel.Address
            cel.Formula = formule
        Next
        'ecrasement des formules par les valeurs
        For Each cel In .Cells
            If cel.Value = 0 Then cel.Value = "" Else cel.Value = cel.Value
        Next
    End With
End Sub




t pour le enregistrer je persiste que si j'ai pas la possibilité de renseigner manuellement mon code à un moment ou un autre ça va compliqué la tache. Les utilisateurs devront renommer en permanence leur fichier. Sans compter que je reste en train de modifier le fichier original et ça fait partie des chose que je cherche à éviter grâce au SaveAs
alors tu n'a pas compris le principe
le model lui ne change jamais!!!!!!!!!! c'est juste la page d'un cahier tu peux même le fermer sans sauver sans quoi que ce soit on s'en fout
 

Anthonymctm

XLDnaute Occasionnel
allez avec un peu moins de fainéantise on recupere les valeurs de l'ancien devis avec des formules de liaison écrasées ensuite par la valeur

VB:
Private Sub CommandButton2_Click()
    Dim filetoopen As Variant, dossier$, nom$, cel As Range, formule$
    ChDir ThisWorkbook.Path
    filetoopen = Application.GetOpenFilename("Devis Files (*.xlsx), *.xlsx", 1, "ouvrir un Devis existant")
    If filetoopen = False Then Exit Sub
    nom = Mid(filetoopen, InStrRev(filetoopen, "\") + 1)
    dossier = Mid(filetoopen, 1, InStrRev(filetoopen, "\"))
    With .Sheets(1).Range("D2,D5:E5,D6:E6,D7:E7,D8:E8,A12:D22")
        'copie des donnée de l'ancien par des formules de liaison
        For Each cel In .Cells
            formule = "='" & dossier & "[" & nom & "]Feuil1'!" & cel.Address
            cel.Formula = formule
        Next
        'ecrasement des formules par les valeurs
        For Each cel In .Cells
            If cel.Value = 0 Then cel.Value = "" Else cel.Value = cel.Value
        Next
    End With
End Sub
Ecoute Patrick, je te remercie, vraiment, mais ne t’embête pas plus, je vais pas changé tout le code que j'ai mis du temps à comprendre et qui fonctionne ^^
En plus tu utilises des méthodes que j'ai jamais vu, la marge d'apprentissage est trop grande pour aujourd'hui :p
 

patricktoulon

XLDnaute Barbatruc
comme tu veux
je vais suivre en silence jusqu'au moment ou il te sera impossible de debuguer sans usine a gaz ;)
  1. sachant maintenant que c'est un fichier sur serveur
  2. que vous etes plusieurs a l'utiliser
  3. peut être même plusieurs utilisateur en même temps
  4. etc..etc....

je t'inviterais alors a nouveau a prendre cette trajectoire ou une autre si quelqu'un a mieux a proposer

bonne route ;)
 

Anthonymctm

XLDnaute Occasionnel
Ah oui en effet le conseil de JMF est bien là, mais donc cette partie là est inutile et surcharge le code du coup
Ah oui je vois, je peux simplement remplacer
VB:
'FirstWord = Mid(nDevis, 1, 4)    ' Returns "DXX-"
'MidWord = Mid(nDevis, 5, 4)    ' Returns "XXXX"
'LastWord = Mid(nDevis, 9)    ' Returns "-XX"

'If FirstWord Like "D[0-9][0-9]-" And MidWord Like "[0-9][0-9][0-9][0-9]" And LastWord Like "-[0-9][0-9]" Then
par
Code:
If nDevis Like "D##-####-##" Then

Ou comment se compliquer la vie pour rien :eek:

Pour ta gestion d'erreur, j'ai mis ça comme ça
VB:
Sub Indicer()
Dim nDevis As String
Dim FirstWord As String, LastWord As String, MidWord As String
Dim Sauvegarde As Variant, Question As Integer

If ThisWorkbook.Name Like "D##-####-##" & ".xlsm" Then
nDevis = InputBox("Saisir le n° devis (n° actuel : " & Left(ThisWorkbook.Name, 11) & ")" & vbCrLf & "Le fichier actuel ne sera pas enregistré." & vbCrLf & "Pensez à enregistrer avant de valider", , Left(ThisWorkbook.Name, 9) & Format(Mid(ThisWorkbook.Name, 10, 2) + 1, "00"))

Else:
nDevis = InputBox("Saisir le n° devis (D" & Right(Year(Now), 2) & "-XXXX-XX)" & vbCrLf & "Le fichier actuel ne sera pas enregistré." & vbCrLf & "Pensez à enregistrer avant de valider", , ThisWorkbook.Name)

End If

If nDevis = "" Then 'si on clique sur annulé
GoTo msg2

End If
 
'FirstWord = Mid(nDevis, 1, 4)    ' Returns "DXX-"
'MidWord = Mid(nDevis, 5, 4)    ' Returns "XXXX"
'LastWord = Mid(nDevis, 9)    ' Returns "-XX"

'If FirstWord Like "D[0-9][0-9]-" And MidWord Like "[0-9][0-9][0-9][0-9]" And LastWord Like "-[0-9][0-9]" Then
If nDevis Like "D##-####-##" Then

On Error GoTo ErrorHandler 'Voir Label ErrorHandler:
 ActiveWorkbook.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & nDevis
   On Error GoTo 0            'On anulle le on error
  
 MsgBox "Devis indicé"
 
Else
msg2:
Msg = "Votre n° doit être de la forme : D" & Right(Year(Now), 2) & "-XXXX-XX" & vbCrLf & vbCrLf & "Réessayer      Enregistrer sous" & vbCrLf & "    |                               |" & vbCrLf & "   \/                              \/"
Style = vbYesNoCancel + vbExclamation + vbDefaultButton1
Title = "Erreur dans le numéro de devis"
Help = "DEMO.HLP"
Ctxt = 1000

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

    If Response = vbYes Then
    Indicer
    ElseIf Response = vbNo Then ' Demande ou sauver le doc et le nom à lui donner
        If nDevis = "" Then
            If ThisWorkbook.Name Like "D##-####-##" & ".xlsm" Then
            nDevis = Left(ThisWorkbook.Name, 9) & Format(Mid(ThisWorkbook.Name, 10, 2) + 1, "00")
            Else: nDevis = ThisWorkbook.Name
            End If
            End If
       Sauvegarde = Application.GetSaveAsFilename(ActiveWorkbook.Path & "\" & nDevis & ".xlsm", FileFilter:="XLSM (*.xlsm), *.xlsm", Title:="Enregistrer-sous ...")
      
        If Sauvegarde = False Then GoTo msg2 ' Si click sur annuler, alors on revient a la boite de dialoque

        If Dir(Sauvegarde) <> "" Then ' le fichier renseigné par l'utilisateur existe-t-il ?
        Question = MsgBox("Attention le fichier existe déjà" & Chr(13) & "Voulez vous le remplacer ?", vbQuestion + vbYesNo, "Attention...")
             ' Si oui, faut t-il l'effacer ?
            If Question = 6 Then ' Oui
              Kill Sauvegarde ' Efface
            Else ' Non
             GoTo msg2 ' On revient a la boite de dialoque
            End If
        
         End If
ThisWorkbook.SaveAs Sauvegarde ' Sauvegarde
  Else: MsgBox "Indiçage annulé" 'si on clique sur annulé
  End If
    
 End If
 
ErrorHandler:
If Err.Number = 1004 Then 'Si on annule la Boite de dialog "écraser..."
    Indicer
Else
    MsgBox "Erreur imprévue : " & Err.Number & vbCrLf & Err.Description
End If

End Sub
Ca règle mon problème !
Par contre ça me met a chaque fois le msg box erreur imprévue : 0, que j'ai créé une erreur ou non :rolleyes:
 

Anthonymctm

XLDnaute Occasionnel
comme tu veux
je vais suivre en silence jusqu'au moment ou il te sera impossible de debuguer sans usine a gaz ;)
  1. sachant maintenant que c'est un fichier sur serveur
  2. que vous etes plusieurs a l'utiliser
  3. peut être même plusieurs utilisateur en même temps
  4. etc..etc....

je t'inviterais alors a nouveau a prendre cette trajectoire ou une autre si quelqu'un a mieux a proposer

bonne route ;)
Bah c'est pour ça que je veux bien que tu me dises ce qui va pas dans ma méthode ^^'
Mais effectivement il est sur un serveur, en tout cas le fichier vierge..
On est plusieurs à l'utiliser,
Plusieurs en même temps non puisque sinon ça s'ouvre en lecture seule.
Le fichier est bourré de macros (mais elles sont toutes indépendantes les unes des autres)

Mais jusque là dans tes messages je vois du scepticisme mais j'arrive pas trop à le comprendre :s
Je me dis qu'il y a peut-être une notion à coteé de laquelle je suis passé, mais par définition je ne sais pas ^^
 

Discussions similaires

Réponses
3
Affichages
2 K

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T