Microsoft 365 VBA -Spliter les instructions d'une ligne de code

[Karakol]

Bonjour le forum,

j'essaie de créer une fonction VBA qui parse du code VBA. J'en suis à l'étape où j'essaie de mettre dans une variable tableau toutes les instructions présentes sur une ligne de code.
Par exemple la ligne

strVar = "Du texte": lngVar = 2

contient 2 instructions :

strVar = "Du texte"
lngVar = 2

Je précise que j'ai déjà une fonction perso qui transforme une ligne "multiligne" en ligne simple:

strVar = "Du texte": _
  lngVar = 2 'Ligne "multiligne"

L'argument CodeLine (la ligne de code à parser) de ma fonction perso contient donc toujours une seule ligne.
Je pensais être arrivé au bout puisque j'arrive au bon résultat avec des lignes un peu tordues telles que :

str = " : 1": str = " : 2": str = " : 2"

ou

str = """ : 1""": str = " "": 2""": str = " "":"" 2"

Mais je m'aperçois que je n'obtiens pas le résultat voulu pour ce genre de lignes :

Next vntSubString: CommentPosition = IIf(blnStringMode, 0, InStr(1, CodeLine, ": "))

J'aimerais vraiment faire quelque chose de générique et rapide d'exécution, je pense que je ne suis plus très loin du résultat final, mais je sèche un peu.
Voici à quoi ressemble ma fonction perso pour le moment :

Public Function SplitInstructions(ByVal CodeLine As String) As Variant()

  Dim vntResult() As Variant
  Dim vntSubString¹ As Variant
  Dim blnIsStringMode As Boolean 'Détermine si on est dans un sous-texte entre guillemets ou non
  Dim vntSubString² As Variant

  Let vntResult = VBA.Array

  If InStr(1, CodeLine, ": ") = 0 Then 'Une seule instruction
    Let vntResult = VBA.Array(CodeLine)
  ElseIf InStr(1, CodeLine, """") = 0 Then 'Plusieurs instructions, mais pas de guillemets => On Split
    Do Until VBA.InStr(1, CodeLine, "::") = 0
      Let CodeLine = VBA.Replace(CodeLine, "::", ":")
    Loop: Call AddToArray(vntResult, Split(CodeLine, ": "))
  Else 'ça se complique
    For Each vntSubString¹ In Split(CodeLine, """")
      If blnIsStringMode Then
        Let vntResult(UBound(vntResult)) = Trim$(vntResult(UBound(vntResult)) & """" & vntSubString¹ & """")
      Else
        For Each vntSubString² In Split(vntSubString¹, ": ")
          If vntSubString² <> vbNullString Then Call AddToArray(vntResult, vntSubString²)
        Next vntSubString²
      End If
      Let blnIsStringMode = Not blnIsStringMode
    Next vntSubString¹
  End If

  Let SplitInstructions = vntResult

End Function

Private Sub AddToArray(ByRef Arr() As Variant, ByVal Value As Variant)

  Dim vntValue As Variant

  If VBA.IsArray(Value) Then
    For Each vntValue In Value
      Call AddToArray(Arr, vntValue)
    Next vntValue
  Else
    ReDim Preserve Arr(LBound(Arr) To UBound(Arr) + 1)
    Let Arr(UBound(Arr)) = Value
  End If

End Sub

Je joins un classeur exemple, pour faire tourner le code, il faut sélectionner une cellule qui contient du texte et cliquer sur le bouton Go.
D'avance, merci pour votre aide !

 

[Karakol]

Bonjour le forum,

j'ai continué de chercher, et ai finalement adopté une approche un tout petit peu différente :

Public Property Get SplitInstructions(ByVal CodeLine As String) As Variant()

  Dim vntResult() As Variant
  Dim vntSubString As Variant
  Dim blnStringMode As Boolean
  Dim x As Long, y As Long
  Dim lngStart As Long

  Let vntResult = VBA.Array

  If VBA.InStr(1, CodeLine, """") = 0 Then
    For Each vntSubString In VBA.Split(CodeLine, ":")
      Let vntSubString = VBA.Trim$(ReplaceAll(vntSubString, "::", ":"))
      If vntSubString <> VBA.vbNullString Then Call AddToArray(vntResult, vntSubString)
    Next vntSubString
  ElseIf VBA.InStr(1, CodeLine, ": ") = 0 Then
    Let vntSubString = VBA.Trim$(ReplaceAll(CodeLine, "::", ":"))
    If vntSubString <> VBA.vbNullString Then Call AddToArray(vntResult, vntSubString)
  Else
    For Each vntSubString In VBA.Split(CodeLine, """")
      If Not blnStringMode Then
        Let x = VBA.InStr(1, vntSubString, ":")
        If x > 0 Then
          Call AddToArray(vntResult, VBA.Mid$(CodeLine, lngStart + 1, x + y - lngStart - 1))
          Let lngStart = y + VBA.InStrRev(vntSubString, ":") + 1
        End If
      End If
      Let blnStringMode = Not blnStringMode
      Let y = y + VBA.Len(vntSubString) + 1
    Next vntSubString
    If x + y - lngStart - 1 > 0 Then
      Call AddToArray(vntResult, VBA.Mid$(CodeLine, lngStart + 1, x + y - lngStart - 1))
    End If
  End If

  Let SplitInstructions = vntResult

End Property

Private Sub AddToArray(ByRef Arr() As Variant, ByVal Value As Variant)

  Dim vntValue As Variant

  If VBA.IsArray(Value) Then
    For Each vntValue In Value
      Call AddToArray(Arr, vntValue)
    Next vntValue
  Else
    ReDim Preserve Arr(LBound(Arr) To UBound(Arr) + 1)
    Let Arr(UBound(Arr)) = Value
  End If

End Sub

Public Function ReplaceAll(ByVal Expression As String, ByVal Find As String, ByVal Replace As String) As String

  Do Until VBA.InStr(1, Expression, Find) = 0
    Let Expression = VBA.Replace(Expression, Find, Replace)
  Loop: Let ReplaceAll = Expression

End Function

Voilà, en espérant que ça serve un jour à quelqu'un