Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Complément (Vba Indenter Interface) V3.1.C Fx4

patricktoulon

XLDnaute Barbatruc
après j'arrête de travailler sur la 2.0 ca devient compliqué de faire pour les deux
on passera directe à la 3.0 si le moteur de la 2 est bon
 

fanch55

XLDnaute Barbatruc
Version 2.0 DE bis?:
Je suppose que c'est la bis la dernière chargée ...
Anomalie précédente résolue .

Les public Enum ne sont pas indentés :


un loupé en exemple ( mais pas dans tous les modules .... ):



Module original:

Module indenté:


Aïe !!! ( je te joins le module qui fait planter : thisworkbook.bas )


Décalage


Je ne pousse pas plus loin .... tu vas me maudire jusqu'à la septième génération ....
 

Pièces jointes

  • Thisworkbook.txt
    4.4 KB · Affichages: 3

patricktoulon

XLDnaute Barbatruc
ok
public enum pas pris a compte je rajoute en moins de deux


pour le then non rédhibitoire c'est normal c'est voulu

le for nexrt decaler je vais voir si j'ai pas oublié de fermer le if couper par underscore(pas bien mechant)

par contre la ton module je vais voir le module qui fout vraiment le boxon

merci
non je te mausi pas (pas encore )
 

patricktoulon

XLDnaute Barbatruc
après click sur debuguage
au dessus de la ligne en jaune ,il suffisait de mettre
un msgox sur ps(i).outerhtml pour voir que le calcul lui a donné "-1" pour l'attribut indent
et effectivement c'est pas bon le min c'est 0
 

patricktoulon

XLDnaute Barbatruc
et oui quand je parlais de code pourri
ce genre de chose c'est imparable même smart indenter le plante cette indentation


serieux ") Then"
 

fanch55

XLDnaute Barbatruc
et oui quand je parlais de code pourri
ce genre de chose c'est imparable même smart indenter le plante cette indentation
Regarde la pièce jointe 1196861

serieux ") Then"
Tu ne peux pas interdire ce qui est permis par le langage ...

Je me suis fié à ton message précédent
J'ai donc modifié les 2 lignes de code de INDENTCODE selon ta remarque:
VB:
        SpaCeHTML = Application.Rept("    ", Application.Max(0, Val(ps(i).getattribute("indent"))))
        SpaCeText = Application.Rept("    ", Application.Max(0, Val(ps(i).getattribute("indent"))))
Et là, tout fonctionne correctement ....
 

patricktoulon

XLDnaute Barbatruc
re
non tout marche pas bien
d'accords ça pète plus mais l'indentation a partir du else(dans ton code) n'est pas bonne
ça fait ça par ce qu'un div n'est pas fermer a cause de tes reports successifs de ligne
j'ai donc éliminé l'idée de les travailler sur les p
je fait un replace du " _" & vbcrlf par un caractères spécial OMEGA chrw$(937)
autrement dit avant d’analyser je n'ai plus de lignes strapées
et je le re décante après et les indente en normalisant du coup maintenant je pourrais choisir la normalisation pour chaque cas comme pour les déclarations d'apis

regarde bien le code que tu m'a donné avec le application.max que tu a fait
 

patricktoulon

XLDnaute Barbatruc
ben l"a voila adaptée pour la 2.0
change toute la fonction
dans le html elle ne sont pas recoupée pour l'instant m"ais dans le vba oui
VB:
'La fonction Magique
Public Function IndentCode()
    Dim EiF As Boolean, CaS As Boolean, TbL, i&, EleM, ps, ReS, cod$, Mot$
    Dim Criter As Boolean, mem, Tbl2, DoC, PrE, Stbl, comm, k
    cod = TextBox1.Text
    cod = Replace(cod, " _" & vbCrLf, " _" & ChrW$(937))
    'des replace eventuels pour eviter les déconvenue avec le html
    '  &#47;=/  -  &lt;=<  -  &gt;=>
    cod = Replace(cod, ">", "&gt;")
    cod = Replace(cod, "<", "&lt;")

    TbL = Split(cod, vbCrLf)
    If checkprogression Then barprogress.Show 0: barprogress.curs.Width = 0: barprogress.Repaint
    If CheckDecompilBlocLine Then
        If checkprogression Then barprogress.Caption = "1° Décompilation des blocs Imbriqués  in one line": barprogress.Repaint
        For i = 0 To UBound(TbL)
            TbL(i) = Trim(TbL(i))
            'les exeptions pour la décompilation en fonction des commentaires
            If Left(TbL(i), 1) <> "'" Then
                If Not TbL(i) Like "* Else *" Then
                    If Not TbL(i) Like "*" & Chr(34) & "*: *" & Chr(34) Then
                        If TbL(i) Like "*'*" And Not Mid(TbL(i), 1, InStr(TbL(i), ": ")) Like "*'*" Then

                            'etc..
                            If InStr(TbL(i), ": ") > 0 Then
                                k = InStrRev(TbL(i), " '")
                                If k > 0 Then
                                    comm = Mid(TbL(i), k)
                                    TbL(i) = Replace(TbL(i), comm, "")
                                    TbL(i) = comm & vbCrLf & Replace(TbL(i), ": ", vbCrLf)
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        Next
        cod = Join(TbL, vbCrLf): TbL = Split(cod, vbCrLf)
    End If
    'dans une variable tableau  qui me sert de mask j'enlève les commentaires
    Tbl2 = TbL
    For i = 0 To UBound(TbL)
        If InStr(2, TbL(i), " '") > 2 Then Tbl2(i) = Trim(Split(TbL(i), " '")(0)) Else Tbl2(i) = Trim(TbL(i))
    Next

    '                                       BALISAGE DANS LES LIGNES DE CODE
    If checkprogression Then barprogress.Caption = "2° Balisage des lignes de codes en html":    ' BarProgress.Repaint
    For i = 0 To UBound(TbL)
        barprogress.curs.Width = (260 / (UBound(TbL) + 1)) * (i + 1): barprogress.Repaint
        TbL(i) = Trim(TbL(i))
        Tbl2(i) = Trim(Tbl2(i))
        Select Case True
            Case " " & Left(Tbl2(i), 15) Like "*Debug.Print*": TbL(i) = "<p typ=""debug"" typ2=""modul"">" & TbL(i) & "</p>"

            Case Left(TbL(i), 1) = "'": TbL(i) = "<p typ=""comm""  typ2=""modul"" style =""color:green;"">" & TbL(i) & "</p>"

            Case Left(TbL(i), 3) = "Dim": TbL(i) = "<p typ=""Dim""  typ2=""modul"">" & TbL(i) & "</p>"

            Case TbL(i) = "": TbL(i) = "<p typ=""vide"" typ2=""modul"">" & TbL(i) & "</p>"

            Case Left(Tbl2(i), 12) = "Private Enum": TbL(i) = "<DIV typ=""BlocType""><p typ=""first""  typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 12) = "End Enum" And Tbl2(i) <> "End Type" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(Tbl2(i), 11) = "Public Enum": TbL(i) = "<DIV typ=""BlocType""><p typ=""first""  typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 12) = "End Enum" And Tbl2(i) <> "End Type" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(Tbl2(i), 5) = "Enum ": TbL(i) = "<DIV typ=""BlocType""><p typ=""first""  typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 12) = "End Enum" And Tbl2(i) <> "End Type" Then TbL(i) = TbL(i) & "</DIV>"

            Case Tbl2(i) = "End Enum": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p> </DIV>":

            Case Left(Tbl2(i), 12) = "Private Type": TbL(i) = "<DIV typ=""BlocType""><p typ=""first""  typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 12) = "End Type" And Tbl2(i) <> "End Type" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(Tbl2(i), 5) = "Type ": TbL(i) = "<DIV typ=""BlocType""><p typ=""first""  typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 12) = "End Type" And Tbl2(i) <> "End Type" Then TbL(i) = TbL(i) & "</DIV>"

            Case Tbl2(i) = "End type": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p> </DIV>":

            Case Left(TbL(i), 8) = "Function": TbL(i) = "<DIV typ=""BlocSub""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 12) = "End Function" And Tbl2(i) <> "End Function" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(TbL(i), 16) = "Private Function": TbL(i) = "<DIV typ=""BlocSub""><p typ=""first""  typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 12) = "End Function" And Tbl2(i) <> "End Function" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(TbL(i), 15) = "Public Function": TbL(i) = "<DIV typ=""BlocSub""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 12) = "End Function" And Tbl2(i) <> "End Function" Then TbL(i) = TbL(i) & "</DIV>"


            Case Tbl2(i) = "End Function": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p> </DIV>":


            Case Left(TbL(i), 3) = "Sub": TbL(i) = "<DIV typ=""BlocSub""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Tbl2(i) Like "*: End Sub" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(TbL(i), 11) = "Private Sub": TbL(i) = "<DIV typ=""BlocSub""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Tbl2(i) Like "*: End Sub" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(TbL(i), 10) = "Public Sub": TbL(i) = "<DIV typ=""BlocSub""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Tbl2(i) Like "*: End Sub" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(TbL(i), 7) = "End Sub": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(TbL(i), 16) = "Private Property": TbL(i) = "<DIV typ=""BlocSub""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Tbl2(i) Like "*: End Property</p>" Then TbL(i) = TbL(i) & "</DIV>"

            Case Tbl2(i) = "End Property": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(TbL(i), 15) = "Public Property": TbL(i) = "<DIV typ=""BlocSub""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Tbl2(i) Like "*: End Property</p>" Then TbL(i) = TbL(i) & "</DIV>"
            Case Left(TbL(i), 12) = "End Property": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"


            Case Left(TbL(i), 5) = "With ": TbL(i) = "<DIV typ=""BlocWith""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If TbL(i) Like "*: End With*</p>" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(Tbl2(i), 8) = "End With": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(TbL(i), 4) = "For ": TbL(i) = "<DIV typ=""BlocFor""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If TbL(i) Like "*: Next*</p>" Then TbL(i) = TbL(i) & "</DIV>"
            Case Left(TbL(i), 4) = "Next": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(TbL(i), 11) = "Select Case":
                TbL(i) = "<DIV typ=""select""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If TbL(i) Like "*: End Select*</p>" Then TbL(i) = TbL(i) & "</DIV>"

            Case Left(TbL(i), 5) = "Case ":
                If CaS = True Then TbL(i - 1) = TbL(i - 1) & "</DIV>":
                TbL(i) = "<DIV typ=""Case""><p typ=""first"" typ2=""cas"">" & TbL(i) & "</p>": CaS = True

            Case Left(TbL(i), 10) = "End Select":
                If CaS Then TbL(i - 1) = TbL(i - 1) & "</DIV>": CaS = False
                TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(TbL(i), 3) = "If ":

                TbL(i) = "<DIV typ=""BlocIf""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Right(Tbl2(i), 4) <> "Then" Then TbL(i) = TbL(i) & "</DIV>"


            Case Left(TbL(i), 7) = "ElseIf ": TbL(i) = "<p typ=""first"" typ2=""elseif"">" & TbL(i) & "</p>"

            Case Left(Tbl2(i) & " ", 5) = "Else ": TbL(i) = "<p typ=""first"" typ2=""Else"" typ2=""modul"">" & TbL(i) & "</p>"

            Case Left(Tbl2(i), 6) = "End If":
                'If EiF = True Then tbl(I - 1) = tbl(I - 1) & "</DIV>"
                TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(TbL(i), 4) = "#If ":
                TbL(i) = "<DIV typ=""BlocdieseIf""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"

            Case Left(Tbl2(i), 5) = "#Else": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"

            Case Left(TbL(i), 7) = "#End If": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(Tbl2(i) & " ", 3) = "Do ":
                TbL(i) = "<DIV typ=""BlocDo""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Tbl2(i) Like "*: loop*</p>" Then TbL(i) = TbL(i) & "</DIV>"

            Case Tbl2(i) = "Loop": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(Tbl2(i), 6) = "While ":
                TbL(i) = "<DIV typ=""BlocWhile""><p typ=""first"" typ2=""modul"">" & TbL(i) & "</p>"
                If Tbl2(i) Like "*: Wend*</p>" Then TbL(i) = TbL(i) & "</DIV>"

            Case Tbl2(i) = "Wend": TbL(i) = "<p typ=""first"" typ2=""modul"">" & TbL(i) & "</p></DIV>"

            Case Left(Tbl2(i) & " ", 5) = "Goto ": TbL(i) = "<p typ=""go"" typ2=""modul"">" & TbL(i) & "</p>"

            Case Left(Tbl2(i) & " ", 6) = "GoSub ": TbL(i) = "<p typ=""go"" typ2=""modul"">" & TbL(i) & "</p>"

            Case Right(Tbl2(i), 1) = ":" And Not Tbl2(i) Like "* *": TbL(i) = "<p typ=""etiq"" typ2=""modul"">" & TbL(i) & "</p>"

            Case Else:
                If i > 0 Then
                    If Right(Tbl2(i - 1), 1) = "_" And (TbL(i - 1) Like "*BlocIf*" Or TbL(i - 1) Like "*suiteIf*") Then
                        TbL(i) = "<p typ=""suiteIf"" typ2=""modul"">" & TbL(i) & "</p>"
                        If Right(Tbl2(i), 1) <> "_" Then TbL(i) = TbL(i) & "</div>"


                    Else
                        TbL(i) = "<p typ=""autre"" typ2=""modul"">" & TbL(i) & "</p>"
                    End If
                Else
                    TbL(i) = "<p typ=""autre"" typ2=""modul"">" & TbL(i) & "</p>"
                End If
        End Select
    Next
    Dim X&

    Set DoC = CreateObject("htmlfile")
    DoC.body.innerhtml = "<pre>" & Join(TbL, vbCrLf) & "</pre>"
    DoC.body.innerhtml = Replace(DoC.body.innerhtml, "<DIV indent=""0""></DIV>", "<DIV>")

    Set PrE = DoC.getelementsbytagname("pre")(0)
    PrE.setattribute "indent", -1
    If checkprogression Then barprogress.Caption = "2° Traitement des attributs ""Indent"" des balises html":    ' BarProgress.Repaint

    For Each EleM In PrE.all: EleM.setattribute "indent", 0: Next
    X = PrE.all.Length
    For Each EleM In PrE.all
        If checkprogression Then barprogress.curs.Width = (260 / X) * (i + 1): barprogress.Repaint
        'base d'indentation se lon l'attribut "indent" et "typ" de l'element
        Select Case EleM.getattribute("typ")
            Case "BlocSub", "etiq", "vide": EleM.setattribute "indent", 0

            Case "BlocIf", "Dim", "BlocFor", "BlocWith", "select", "BlocWhile", "BlocdieseIf", "BlocDo", "debug"
                EleM.setattribute "indent", Val(EleM.parentelement.getattribute("indent")) + 1

            Case "Case", "first", "ElseIf", "comm", "suiteIf": EleM.setattribute "indent", Val(EleM.parentelement.getattribute("indent"))

            Case "autre", "go", "BlocType": EleM.setattribute "indent", Val(EleM.parentelement.getattribute("indent")) + 1
        End Select

        'indentation selon  les checkbox et l'attribut indent de l'élément
        If Not CheckDim Then
            If EleM.getattribute("typ") = "Dim" Then EleM.setattribute "indent", 0
        Else
            If EleM.getattribute("typ") = "Dim" Then EleM.setattribute "indent", Val(EleM.parentelement.getattribute("indent")) + 1
        End If

        If Not CheckComm Then
            If EleM.getattribute("typ") = "comm" Then EleM.setattribute "indent", 0
        Else
            If EleM.getattribute("typ") = "comm" Then EleM.setattribute "indent", Val(EleM.parentelement.getattribute("indent")) + 1
        End If

        If CheckCase Then
            If EleM.parentelement.getattribute("typ") = "Case" Then EleM.setattribute "indent", Val(EleM.parentelement.getattribute("indent")) + 2
            If EleM.getattribute("typ2") = "cas" Then EleM.setattribute "indent", Val(EleM.parentelement.getattribute("indent")) + 1
        End If

        If Not CheckGo Then If EleM.getattribute("typ") = "Go" Then EleM.setattribute "indent", 0

        If Not CheckDCC Then If EleM.getattribute("typ") = "BlocdieseIf" Then EleM.setattribute "indent", 0

      

    Next

    'Debug.Print Join(tbl, vbCrLf)
    Dim res2, SpaCeHTML$, SpaCeText$    ', plusHtml, plusText, plusx
    Set ps = DoC.getelementsbytagname("p")
    If checkprogression Then barprogress.Caption = " RESTITUTION DES LIGNES DE CODE INDENTEES"
    For i = 0 To ps.Length - 1
        If checkprogression Then barprogress.curs.Width = (260 / ps.Length) * (i + 1): barprogress.Repaint
        If ps(i).getattribute("indent") = -1 Then ps(i).setattribute "indent", 0
        'MsgBox ps(i).outerhtml
        SpaCeHTML = Application.Rept("&nbsp;&nbsp; &nbsp;", Val(ps(i).getattribute("indent")))
        SpaCeText = Application.Rept("    ", Val(ps(i).getattribute("indent")))
        ps(i).innerhtml = SpaCeHTML & ps(i).innerhtml
        ps(i).Style.margin = 0
        ps(i).innerhtml = SpaCeHTML & Trim(ps(i).innerhtml)
        res2 = res2 & ps(i).outerhtml & vbCrLf
        ReS = ReS & SpaCeText & Trim(ps(i).innertext) & vbCrLf



    Next
    TbL = Split(ReS, vbCrLf)
    Dim tbl4, A&, SpoC
    For i = 0 To UBound(TbL)
        If TbL(i) Like "*" & ChrW$(937) & "*" Then
          'MsgBox TbL(i)
          SpoC = ""
           tbl4 = Split(TbL(i), ChrW$(937))
            Select Case True
           Case tbl4(0) Like "*Declare*function*": SpoC = Application.Rept(" ", 30)
            Case tbl4(0) Like "*""*": SpoC = Application.Rept(" ", InStr((TbL(i)), """"))
          Case tbl4(0) Like "*(*)*": SpoC = Application.Rept(" ", InStr((TbL(i)), "("))
           Case tbl4(0) Like "*_*": SpoC = Application.Rept(" ", InStr(Trim(TbL(i)), "_") - 5)
          Case Else: SpoC = ""
            End Select
            tbl4 = Split(TbL(i), ChrW$(937))
            For A = 1 To UBound(tbl4)
             'MsgBox "|" & tbl4(A)
        
            tbl4(A) = SpoC & Replace(Trim(tbl4(A)), Chr(160), ""): Next
            TbL(i) = Join(tbl4, vbCrLf)
        End If

    Next



    ReS = Join(TbL, vbCrLf)
    htmlCod = res2
    OriginalHtmlCode = PrE.outerhtml
    'Debug.Print ReS



    TextBox2 = ReS
    IndentCode = ReS
    Unload barprogress
End Function
2.0
 

fanch55

XLDnaute Barbatruc
Bonjour @patricktoulon ,

Test moteur v3 :

1) Je me demande s'il ne faudrait pas ne pas indenter les If-Then simples :


2) Une petite évolution qui me semblerait pas mal :
Bien que ce soit indiqué en bas d'userform, je suis parfois passé dans des modules sans les indenter au préalable ( trop rapide ou pressé ) : Le fond du Textbox en blanc quand le module n'est pas indenté et en couleur clair pastel quand il l'est . Qu'en penses-tu ?

3) "monsieur plus"
peux-t-on aligner les byval ( design ... )



4) Indentation Sub ou Function à peut-être affiner .
Originel

Indenté


5) Code partiellement numéroté ( ) [ tu t'en sors bien, j'appréhendais cette partie ]
Originel

Indenté

Originel


Indenté


Originel

Indenté



It's all folk pour aujourd'hui ...
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…