'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
' /=/ - <=< - >=>
cod = Replace(cod, ">", ">")
cod = Replace(cod, "<", "<")
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(" ", 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