[VBA] Gestion d'erreur

Anthonymctm · 8 Juin 2020

Bonjour Le forum,

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

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.

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

Anthonymctm · 9 Juin 2020

patricktoulon à dit:
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 · 9 Juin 2020

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!!!!!

si le devis que tu copie a été suivi de 36 autres ben ton index+1 walouh!!! walouh !!!!
ça implique qu'il faut du vba dans chaque devis (inacceptable conceptuellement)
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

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:

un model devis vierge(celui toujours utilisé)
avec un bouton donnant la possibilité de copier le contenu d'un ancien (je dis bien copier le contenu et non le fichier )
utiliser mon model précédemment donné (plus haut dans la discussion)pour enregistrer

voila ma conception de la souplesse

A méditer

Anthonymctm · 9 Juin 2020

patricktoulon à dit:
ç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.

patricktoulon à dit:
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

patricktoulon à dit:
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

Plus sérieusement, c'est de quel défaut dont tu parles ?

patricktoulon à dit:
un model devis vierge(celui toujours utilisé)

avec un bouton donnant la possibilité de copier le contenu d'un ancien (je dis bien copier le contenu et non le fichier )

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.

patricktoulon · 9 Juin 2020

re

erreur. (ce cas là est prévu quand je passe par l'enregistrer sous aux deuxième msgbox.

oui!! sauf qu'il y en a 36 qui ont été rédiger avant aujourd’hui comment tu fait 36 msgbox

laisse moi 5 minutes je fait une maquette tu va comprendre

_Thierry · 9 Juin 2020

Re Bonjour
Sans me méler du pour ou contre "liberté" de l'inputbox...

Anthonymctm à dit:
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 · 9 Juin 2020

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

Anthonymctm · 9 Juin 2020

_Thierry à dit:
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

_Thierry à dit:
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

Mais ya des chances pour que ce soit la sollution que je cherche, je vais creuser

_Thierry · 9 Juin 2020

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 :

Anthonymctm à dit:
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 :

Anthonymctm à dit:
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 · 9 Juin 2020

patricktoulon à dit:
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 · 9 Juin 2020

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 · 9 Juin 2020

patricktoulon à dit:

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

patricktoulon · 9 Juin 2020

comme tu veux
je vais suivre en silence jusqu'au moment ou il te sera impossible de debuguer sans usine a gaz

sachant maintenant que c'est un fichier sur serveur
que vous etes plusieurs a l'utiliser
peut être même plusieurs utilisateur en même temps
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 · 9 Juin 2020

_Thierry à dit:
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

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

Anthonymctm · 9 Juin 2020

patricktoulon à dit:
comme tu veux
je vais suivre en silence jusqu'au moment ou il te sera impossible de debuguer sans usine a gaz

sachant maintenant que c'est un fichier sur serveur

que vous etes plusieurs a l'utiliser

peut être même plusieurs utilisateur en même temps

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 ^^

patricktoulon · 9 Juin 2020

[parehteses]
a ben voilà on commence déjà avec les goto et même un récursif sur condition si
[parentheses]

[VBA] Gestion d'erreur

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums