7,759
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
Private Sub Command1_Click()
Dim strTest As String
strTest = strTest & " Private _" & vbCrLf
strTest = strTest & "Function jia2(a As Long, _" & vbCrLf
strTest = strTest & "ByVal b As Integer) As Long '加法 函数" & vbCrLf
strTest = strTest & " jia = a + b: Dim k As Long: k = 3" & vbCrLf
strTest = strTest & "Dim S: S = ""中国人 "" '88382':" & vbCrLf
strTest = strTest & "if 1=1 then" & vbCrLf
strTest = strTest & "for i = 1 to 100" & vbCrLf
strTest = strTest & "doevents:debug.print i " & vbCrLf
strTest = strTest & "next " & vbCrLf
strTest = strTest & "elseif 1=2 then " & vbCrLf
strTest = strTest & "doevents:debug.print i " & vbCrLf
strTest = strTest & "else " & vbCrLf
strTest = strTest & "doevents:debug.print i " & vbCrLf
strTest = strTest & "end if " & vbCrLf
strTest = strTest & "End _" & vbCrLf
strTest = strTest & "Function"
Debug.Print strTest
Debug.Print vbCrLf & "分隔线---------------------------" & vbCrLf
Debug.Print formatVBcode(strTest)
End Sub
Private Function formatVBcode(ByVal strin As String) As String
Dim strTmp As String
Dim aryTmp() As String
Dim colcode As New Collection
Dim i As Long, j As Long
Dim lngDimRow As Long, lngTabCnt As Long
Dim strTab As String
'去他妈的所有换行连接
strTmp = Replace(strin, " _" & vbCrLf, " ")
'去他妈的冒号并行,当然这边可能把字符串里面的冒号也折行了,自己改进一下吧。
strTmp = Replace(strTmp, ":", vbCrLf)
'按行拆分
aryTmp = Split(strTmp, vbCrLf)
'去空行,去前后空格,然后塞进我个人喜欢的集合
For i = LBound(aryTmp) To UBound(aryTmp)
If aryTmp(i) <> "" Then
colcode.Add Trim(aryTmp(i))
End If
Next
lngDimRow = 2
For i = 2 To colcode.Count - 1 '第一行和第二行懒得处理了,
If GetKeyWord(colcode(i)) = "DIM" Then '遇到dim,加挪到最前面去
colcode.Add colcode(i), , lngDimRow
colcode.Remove i + 1
End If
Next
'添加缩进,输出
lngTabCnt = 1
formatVBcode = formatVBcode & Trim(colcode(1)) & vbCrLf
For i = 2 To colcode.Count - 1 '第一行和第二行懒得处理了,
strTab = Replace(Space(lngTabCnt * 4), " ", vbTab) '需要缩进的tab
If GetKeyWord(colcode(i)) = "IF" Or GetKeyWord(colcode(i)) = "FOR" Then '遇到 if 和 for 则后续的行家一格缩进 当然,还有其他关键字,自己添加,懒得写了
formatVBcode = formatVBcode & strTab & colcode(i) & vbCrLf '本行加上缩进
lngTabCnt = lngTabCnt + 1
ElseIf GetKeyWord(colcode(i)) = "NEXT" Or GetKeyWord(colcode(i)) = "END" Then '本行及后续向前一格
lngTabCnt = lngTabCnt - 1
strTab = Replace(Space(lngTabCnt * 4), " ", vbTab)
formatVBcode = formatVBcode & strTab & colcode(i) & vbCrLf
ElseIf GetKeyWord(colcode(i)) = "ELSEIF" Or GetKeyWord(colcode(i)) = "ELSE" Then '本行及后续缩进不变
strTab = Replace(Space((lngTabCnt - 1) * 4), " ", vbTab)
formatVBcode = formatVBcode & strTab & colcode(i) & vbCrLf
Else
formatVBcode = formatVBcode & strTab & colcode(i) & vbCrLf
End If
Next
formatVBcode = formatVBcode & Trim(colcode(colcode.Count - 1))
End Function
Private Function GetKeyWord(strin As String)
Dim i As Integer
i = InStr(1, strin, " ")
If i > 1 Then
GetKeyWord = UCase(Left(strin, InStr(1, strin, " ") - 1))
Else
GetKeyWord = UCase(strin)
End If
End Function
Private _
Function jia2(a As Long, _
ByVal b As Integer) As Long '加法 函数
jia = a + b: Dim k As Long: k = 3
Dim S: S = "中国人 " '88382':"
End _
Function