dionys0s
XLDnaute Impliqué
Bonjour le forum,
j'aimerais avoir votre avis sur une fonction écrite par mes soins.
Il s'agit d'une fonction de concaténation en quelque sorte.
Soit du code écrit comme suit :
Ma fonction le transforme en :
Le tout récupéré dans une variable String bien sûr.
La fonction que j'ai mise au point fonctionne, mais je souhaite avoir votre avis. Ai-je oublié des cas de figures ? Des possibilités d'écriture non prises en compte ? Je ne suis pas certain de maîtriser 100% des possibilités offertes par la syntaxe de VBA, donc si des experts généreux passent par là, je serais ravi d'avoir leur avis.
D'avance merci, beaucoup.
P.S : j'ai bien commenté le code pour essayer de le pas perdre les éventuels lecteurs. Et ai crée un macro de test facile comme tout à exécuter.
P.S2 : pour les personnes que ça rase d'ouvrir le classeur, le code ci-dessous :
j'aimerais avoir votre avis sur une fonction écrite par mes soins.
Il s'agit d'une fonction de concaténation en quelque sorte.
Soit du code écrit comme suit :
VB:
LngVar = _
Fonction1(Arg1, "Blabla (blabla.") + _
Fonction2(Arg2, "Bloblo (bloblo.")) 'BlubluMa fonction le transforme en :
VB:
LngVar = Fonction1(Arg1, "Blabla (blabla.") + Fonction2(Arg2, "Bloblo (bloblo.")) 'BlubluLe tout récupéré dans une variable String bien sûr.
La fonction que j'ai mise au point fonctionne, mais je souhaite avoir votre avis. Ai-je oublié des cas de figures ? Des possibilités d'écriture non prises en compte ? Je ne suis pas certain de maîtriser 100% des possibilités offertes par la syntaxe de VBA, donc si des experts généreux passent par là, je serais ravi d'avoir leur avis.
D'avance merci, beaucoup.
P.S : j'ai bien commenté le code pour essayer de le pas perdre les éventuels lecteurs. Et ai crée un macro de test facile comme tout à exécuter.
P.S2 : pour les personnes que ça rase d'ouvrir le classeur, le code ci-dessous :
VB:
Option Explicit 'Module APPELS
Public Sub Test()
Dim i As Long, Module As String, CodeLine As String
With Excel.ThisWorkbook: i = 2: Do Until .Worksheets(1).Cells(i, 1).Value = "" Or .Worksheets(1).Cells(i, 2).Value = ""
Module = .Worksheets(1).Cells(i, 1).Value: CodeLine = .Worksheets(1).Cells(i, 2).Value
.Worksheets(1).Cells(i, 3).Formula = ProperLine(.VBProject.VBComponents(Module).CodeModule, CodeLine)
i = i + 1: Loop: End With
End Sub
VB:
Option Explicit 'Module OUTILS
'Le nommage de la fonction 'ProperLine' est volontairement rédigé de façon dégueulasse. C'est pour le test.
Public Function _
ProperLine _
( _
CodMod _
As VBIDE _
. _
CodeModule, ByVal StartLine As Long, _
Optional _
Arg1 _
As _
String _
= _
" . " _
, _
Optional Arg2 As String = " . " _
_
) _
As _
String 'Si la ligne de code se poursuit sur les lignes suivantes (" _"), cette fonction la 'contracte' en une seule. _
Ici, les arguments Arg1 et Arg2 ne servent à rien d'autre qu'à tester la fonction. Ils dégageront plus tard.
Dim Code As String, k As Long
If StartLine > 1 Then
'j'ajouterai check pour vérifier que la ligne du dessus ne termine pas par " _"
ElseIf StartLine > CodMod.CountOfLines Then
'erreur. A écrire plus tard.
End If
1 If StartLine > CodMod.CountOfLines Then GoTo 2 'Inutile au premier passage, utile par la suite
Code = VBA.Trim(CodMod.Lines(StartLine, 1))
If Code = "_" Then StartLine = StartLine + 1: GoTo 1 'Si la ligne est vide et non contient qu'un underscore _
(comme ici en ligne 10. C'est con je sais, mais c'est un cas de figure possible.")
If VBA.Right(Code, 2) = " _" Then 'ça va à la ligne.
ProperLine = ProperLine & VBA.Left(Code, VBA.Len(Code) - 1)
StartLine = StartLine + 1: GoTo 1
Else: ProperLine = ProperLine & Code: End If 'ça ne va pas à la ligne => on passe à la finalisation.
'Finalisation : il s'agit de supprimer les espace en trop qu'il peut y avoir, avant et/ou après des parenthèses, _
des points ou des virgules, mais sans défoncer le ou les éventuels arguments textes 'en dur' dans le code. _
Par exemple _
Optional Arg1 As String = "Une valeur (une précision)" => le texte en dur = "Une valeur (une précision)" _
Ou encore _
MonTexte = "Du texte (une précision)." => le texte en dur = "Du texte (une précision)."
2 Code = ProperLine: ProperLine = VBA.vbNullString: k = StrArgPos(Code)
3 If k > 0 Then 'Il y a (encore) du texte en dur
GoSub 4: GoSub 5: GoSub 6: GoSub 5
Else: k = CmtPos(Code) 'Il n'y a pas (ou plus) de texte en dur => on met la fin de la ligne.
If k > 0 Then 'Il y a des commentaires
GoSub 4: GoSub 5: k = VBA.Len(Code): GoSub 6
Else: k = VBA.Len(Code): GoSub 4: End If: Exit Function 'C'est terminé.
End If: GoTo 3 'On retourne voir s'il subsiste du texte 'en dur'
'Nettoyage des potentiels espaces en trop
4 ProperLine = ProperLine & VBA.Replace(VBA.Replace(VBA.Replace(VBA.Replace(VBA.Replace(VBA.Replace( _
VBA.Mid(Code, 1, k), _
" (", "("), _
"( ", "("), _
". ", "."), _
" .", "."), _
" ,", ","), _
" )", ")"): Return 'Ai-je oublié des cas de figures possibles ?
'Mise à jour des variables 'Code' et 'k'
5 Code = VBA.Mid(Code, k + 1, VBA.Len(Code) - k): k = StrArgPos(Code): Return
'On ajoute sans modifier
6 ProperLine = ProperLine & VBA.Mid(Code, 1, k): Return
End Function
Private Function StrArgPos(StrCode As String) As Long ' _
Renvoie le rang du premier texte en dur d'une ligne de code, 0 s'il n'y en a pas
Dim UChr As Long 'Upper Character => UChr
UChr = CmtPos(StrCode)
If UChr = 0 Then UChr = VBA.Len(StrCode)
For StrArgPos = 1 To UChr 'On ne regarde pas dans les commentaires
If VBA.Mid(StrCode, StrArgPos, 1) = """" Then Exit Function
Next StrArgPos: StrArgPos = 0
End Function
Private Function CmtPos(StrCode As String) As Long ' _
Renvoie le rang du premier caractère d'un commentaire d'une ligne de code, 0 s'il n'a a pas de commentaire
Dim StrArg As Boolean
If VBA.Left(VBA.Trim(StrCode), 4) = "Rem " Then
CmtPos = VBA.InStr(1, StrCode, "Rem ")
Else: For CmtPos = 1 To VBA.Len(StrCode)
If VBA.Mid(StrCode, CmtPos, 1) = """" Then
StrArg = Not StrArg
ElseIf Not StrArg Then
If VBA.Mid(StrCode, CmtPos, 1) = "'" Then Exit Function
End If: Next CmtPos: CmtPos = 0: End If
End Function
