Définir une valeur d'erreur Err en vba

KenDev

XLDnaute Impliqué
Bonjour à tous,

J'écris une fonction de manipulation de string, destinée à un Addin, qui renvoit un string. Je dois vérifier que l'entrée string réponde à certains critères. Comment faire pour que, si ces critères ne sont pas remplis, la fonction me renvoie un err.number (et un err.description) que j'aurai défini ?

Si c'est possible, comment trouver un err.number libre ? J'avais envisagé :
VB:
For i = 1001 To 10000
    Err.Number = i
    Cells(i, 1) = Err.Description
Next i
et choisir ainsi parmi les cellules vides, mais ce code s'éxécute sans rien écrire.

Et enfin comment définir une erreur en vba ?

Dans un premier temps, merci de m'avoir lu. :) Cordialement.

KD

Edit : J'ai trouvé pour les deux premières questions
VB:
Sub erdsg()
    On Error GoTo erRline
For i = 1 To 65536
    Err.Raise i
Next i
erRline:
    Cells(i, 1) = Err.Number
    Cells(i, 2) = Err.Description
    Resume Next
End Sub
 
Dernière édition:

KenDev

XLDnaute Impliqué
Re : Définir une valeur d'erreur Err en vba

Bonjour Hippolite, le fil,

Merci pour le lien et pour ton intérêt. Je connais et utilise déjà les gestion des erreurs (surement pas toujours au mieux).Le souci dans ce cas particulier est qu'une mauvaise entrée ne sera pas forcément considérée par Excel comme un erreur. La fonction reçoit un string devant correspondre à un chemin complet vers un fichier local et, selon l'option choisie, ressortir soit l'extension, soit le nom du fichier sans extension, soit le chemin, soit le dossier ou enfin soit le dossier parent. On peut donc imaginer tout un tas d'entrées biscornues qui ne seront pas considérée comme erreur par Excel mais qui pour moi devraient en renvoyée une formattée.

Le code depuis hier :
VB:
Function ExPaLoFi(vPath As String, vbOpt As Byte)
    'extrait d'un filelongname d'un fichier local une chaine selon option vbOpt
    'Option 0 : extension du fichier avec "."
    'Option 1 : nom du fichier sans extension
    'Option 2 : Path avec "\" final
    'Option 3 : Nom du Dossier
    'Option 4 : Nom du Dossier Parent
    
    Dim vStr() As String 
    Dim Txt As String 
    
    On Error GoTo ErrLine
    
    If vbOpt > 4 Then
        Err.Raise 5
    End If
    
    ReDim vStr(0 To 4)
    
    'extension
    vStr(0) = ""
    Txt = vPath
    Do While Left(vStr(0), 1) <> "."
        vStr(0) = Right(Txt, 1) & vStr(0)
        If vStr(0) = "\" Then Err.Raise 93 'Error Pattern String
        If Left(vStr(0), 1) = "\" Then Err.Raise 93
        Txt = Left(Txt, Len(Txt) - 1)
    Loop
    If vbOpt = 0 Then
        ExPaLoFi = vStr(0)
        Exit Function
    End If
    
    'name
    vStr(1) = ""
    Do While Left(vStr(1), 1) <> "\"
        vStr(1) = Right(Txt, 1) & vStr(1)
        Txt = Left(Txt, Len(Txt) - 1)
        If Txt = "" Then Err.Raise 93
    Loop
    If vbOpt = 1 Then
        ExPaLoFi = Right(vStr(1), Len(vStr(1)) - 1)
        Exit Function
    End If
    
    'path"
    If vbOpt = 2 Then
        ExPaLoFi = Txt & "\"
        Exit Function
    End If
    
    'dossier
    vStr(3) = ""
    Do While Left(vStr(3), 1) <> "\"
        vStr(3) = Right(Txt, 1) & vStr(3)
        Txt = Left(Txt, Len(Txt) - 1)
        If Txt = "" Then Err.Raise 93
    Loop
    If vbOpt = 3 Then
        ExPaLoFi = Right(vStr(3), Len(vStr(3)) - 1)
        Exit Function
    End If
    
    'dossier
    vStr(4) = ""
    Do While Left(vStr(4), 1) <> "\"
        vStr(4) = Right(Txt, 1) & vStr(4)
        Txt = Left(Txt, Len(Txt) - 1)
        If Txt = "" Then Err.Raise 93
    Loop
    If vbOpt = 4 Then
        ExPaLoFi = Right(vStr(4), Len(vStr(4)) - 1)
        Exit Function
    End If
    
ErrLine:
    MsgBox Err.Number & Chr(10) & Err.Description & Chr(10) & "AddIn UPath.xla" & _
        Chr(10) & "Function Expalofi"
   
End Function

J'intercepte quelques erreurs évidente, ce qui me chagrine encore un peu c'est que ce code ne soit pas bulletproof :) Cordialement

KD
 

KenDev

XLDnaute Impliqué
Re : Définir une valeur d'erreur Err en vba

Re,

Merci à vous deux pour vos réponses et/ou encouragements!

@hasco : J'avais lu ces deux aides avant de poster mais trop superficiellement apparemment...

@Hippolite : C'est tout à fait ça...

Avec un peu plus de recul, je vais faire beaucoup plus simple : Vérifier que le fichier existe bien (ou pourrait exister, la fonction pouvant servir à définir un emplacement de création) en début de fonction et si non renvoyer une chaine spécifique (avec au moins un caractère interdit pour éviter le cas particulier message = nom du fichier ou dossier..), ensuite il ne restera a gérer que les cas dossier/parent inexistant.

Cordialement

KD
 
G

Guest

Guest
Re : Définir une valeur d'erreur Err en vba

Re,

Fais une recherche sur FileSystemObject sur google.

Tu pourrais avoir une fonction ressemblant à (les case 3 et 4 ne sont pas traités)
En tous cas voici à quoi pourrait ressembler ta gestion d'erreurs

Code:
Function ExPaLoFi(vPath As String, vbOpt As Byte)
'extrait d'un filelongname d'un fichier local une chaine selon option vbOpt
'Option 0 : extension du fichier avec "."
'Option 1 : nom du fichier sans extension
'Option 2 : Path avec "\" final
'Option 3 : Nom du Dossier
'Option 4 : Nom du Dossier Parent
    Const Source As String = "Fonction ExPaLoFi"
    Dim fso, file, folder
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error GoTo FinExPaLoFi
    
    If Not fso.FileExists(vPath) Then Err.Raise 513, Source, "Fichier inexistant"
    
    'Le Fichier existe
    Set file = fso.GetFile(vPath)
    
    ' Si un problème fso est survenu (exceptionnel)
    If file Is Nothing Then Err.Raise 514, Source, "Pour une raison inconnue le chemin n'a pu être résolu"
    
    'LeDossier
     Set folder = file.ParentFolder
     If folder Is Nothing Then Err.Raise 515, Source, "Pour une raison inconnue le chemin du dossier n'a pu être résolu"
     
    'on a le fichier et le dossier
    Select Case vbOpt
        Case 0: ExPaLoFi = "." & Split(file.Name, ".")(1)
        Case 1: ExPaLoFi = Split(file.Name, ".")(0)
        Case 2: ExPaLoFi = folder.Path & "\"
        Case 3:
        Case 4
    End Select
 
FinExPaLoFi:
    If Err.Number > 0 Then
        MsgBox Err.Number & Chr(10) & Err.Description & Chr(10) & "AddIn UPath.xla" & _
               Chr(10) & "Function Expalofi"
    End If
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing
End Function

A+
 

KenDev

XLDnaute Impliqué
Re : Définir une valeur d'erreur Err en vba

Bonjour à tous,

Bon, après moult essais j'abandonne. Le fait de vouloir accepter en plus des chaines fichiers et dossiers existants, les chaines fichiers et dossiers créables localement (ce que je n'ai pas bien expliqué dans les posts précédents) est un peu trop compliqué. J'en entrevois la possibilité mais un résultat approchant commence à ressembler à une usine à gaz pour une simple fonction. Toutefois cela m'a permis de visiter en long, (et presque en large) la bibliothèque FileSystemObject (Merci Hasco !), d'être plus à l'aise avec F2 et de réviser mes MkDir et autres Open Output. :)

Cordialement

KD
 

Discussions similaires

Réponses
6
Affichages
250

Membres actuellement en ligne

Statistiques des forums

Discussions
312 338
Messages
2 087 397
Membres
103 535
dernier inscrit
moimeme1