Option Explicit
Dim conData As Long '= 16
Dim conSpecial As Long '= 4
Dim conFunction As Long '= 18
Dim conKeywordCount As Long '= 145
Const conBl As String = "<span style=""color:#0000FF;"">" '0000FF,000088
Const conGr As String = "<span style=""color:#qwerty;"">" 'Sau do chuyen thanh #008800
Const conAf As String = "</span>"
Const conLine As String = "<hr>"
Const conText1 As String = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN"" ""http://www.w3.org/TR/html4/loose.dtd"">" & vbCrLf
Const conText2 As String = "<html>" & vbCrLf & " <head>" & vbCrLf
Const conText3 As String = " <title>_Title_</title>" & vbCrLf & " </head>" & vbCrLf
Const conText4 As String = " <body text=""Black"" bgcolor=""White"">" & vbCrLf & " <basefont size=""3"">" & vbCrLf & " <pre>" & vbCrLf
Const conText5 As String = vbCrLf & " </pre>" & vbCrLf & " </body>" & vbCrLf & "</html>"
Function Conv_Main(ByVal strText As String) As String
Dim c As Long, i As Long, j As Long, k As Long, lngLen As Long
Dim strLine As String
Dim strValue As String
Dim strKeyword As String
Dim varData As Variant
Dim varKeyword As Variant
Dim varSpecial As Variant
Dim varFunction As Variant
Dim strJoinText(1 To 5) As String
Dim varSplit As Variant
'Dinh nghia cac keyword VBA:
With ThisWorkbook.Worksheets(1)
varKeyword = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Value 'Cac keyword: And, As, GoSub, Sub,...
varData = .Range("B1", .Cells(.Rows.Count, "B").End(xlUp)).Value 'Kieu du lieu: As Long, As Integer, As Date
varFunction = .Range("C1", .Cells(.Rows.Count, "C").End(xlUp)).Value 'Cac ham so hay dung: CInt( , CDate( , Input(
varSpecial = .Range("D1", .Cells(.Rows.Count, "D").End(xlUp)).Value 'Cac tu khoa dac biet: True, False, Name, Object
End With
conKeywordCount = UBound(varKeyword, 1) - LBound(varKeyword, 1) + 1 'So keyword cot A. Ex: 145
conData = UBound(varData, 1) - LBound(varData, 1) + 1 'So keyword cot B. Ex: 16
conFunction = UBound(varFunction, 1) - LBound(varFunction, 1) + 1 'So keyword cot C. Ex: 18
conSpecial = UBound(varSpecial, 1) - LBound(varSpecial, 1) + 1 'So keyword cot D. Ex: 4
'Chen dong line vao cuoi End Sub...
strLine = vbCrLf & conLine
strText = Replace$(strText, "End Sub" & vbCrLf, "End Sub" & strLine)
strText = Replace$(strText, "End Function" & vbCrLf, "End Function" & strLine)
strText = Replace$(strText, "End Property" & vbCrLf, "End Property" & strLine)
If 0 < InStr(1, strText, vbCrLf) Then
'Xoa bo dong line cuoi cung
varSplit = Split(strText, vbCrLf)
For i = UBound(varSplit) To LBound(varSplit) Step -1
strValue = varSplit(i)
If Replace$(strValue, " ", "") <> "" Then
If strValue = conLine Then varSplit(i) = vbNullString
Exit For
End If
Next
'Dong line phan tach phan KhaiBao va Sub/Function
For i = LBound(varSplit) To UBound(varSplit)
If (0 < InStr(1, varSplit(i), "Sub ") And 0 = InStr(1, varSplit(i), "Declare ")) _
Or (0 < InStr(1, varSplit(i), "Function ") And 0 = InStr(1, varSplit(i), "Declare ")) _
Or 0 < InStr(1, varSplit(i), "Property ") Then
j = InStr(1, varSplit(i), "'")
If j = 0 _
Or (0 < InStr(1, varSplit(i), "Sub ") And InStr(1, varSplit(i), "Sub ") < j) _
Or (0 < InStr(1, varSplit(i), "Function ") And InStr(1, varSplit(i), "Function ") < j) _
Or (0 < InStr(1, varSplit(i), "Property ") And InStr(1, varSplit(i), "Property ") < j) Then 'Xu ly ca voi comment
j = i
Do
j = j - 1
If j <= LBound(varSplit) Then
strText = Join$(varSplit, vbCrLf)
Exit For
End If
strValue = Replace$(varSplit(j), " ", "")
If strValue <> "" And Not Left$(strValue, 1) = "'" Then
varSplit(j) = varSplit(j) & vbCrLf & "_poiuytr_"
strText = Join$(varSplit, vbCrLf)
strText = Replace$(strText, "_poiuytr_" & vbCrLf, conLine)
Exit For
End If
Loop
End If
End If
Next
End If
strJoinText(2) = conBl
strJoinText(4) = conAf
'Tim kiem comment, hien thi chu mau xanh luc
strText = Replace$(strText, " '", " " & conGr & "'")
strText = Replace$(strText, "<hr>'", "<hr>" & conGr & "'")
strText = Replace$(strText, vbCrLf & "'", vbCrLf & conGr & "'")
If Left$(strText, 1) = "'" Then strText = conGr & strText
'Tim kiem kieu DuLieu, cho hien thi mau xanh da troi
For i = 1 To conData
strJoinText(3) = varData(i, 1)
strText = Replace$(strText, varData(i, 1), Join$(strJoinText, ""))
Next
'Tim kiem ham so, cho hien thi mau xanh da troi
For i = 1 To conFunction
strJoinText(3) = varFunction(i, 1)
strText = Replace$(strText, varFunction(i, 1), Join$(strJoinText, ""))
lngLen = 1
strJoinText(3) = ")"
Do
j = InStr(lngLen, strText, varFunction(i, 1))
lngLen = j + Len(varFunction(i, 1))
If j = 0 Then Exit Do
c = 0: k = 0
Do '")" cung cho hien thi mau xanh da troi
strValue = Mid$(strText, lngLen + c, 1)
If strValue = ")" Then
If k = 0 Then
strJoinText(1) = Left$(strText, lngLen + c - 1)
strJoinText(5) = Mid$(strText, lngLen + c + 1)
strText = Join$(strJoinText, "")
strJoinText(1) = ""
strJoinText(5) = ""
Exit Do
Else
k = k - 1
End If
ElseIf strValue = "(" Then
k = k + 1
End If
c = c + 1
Loop Until c = 10000
Loop Until c = 10000
Next
'Tim kiem Keyword, cho hien thi mau xanh da troi
strText = Replace$(strText, "#If ", "#" & conBl & "If" & conAf & " ")
strText = Replace$(strText, "#Else", "#" & conBl & "Else" & conAf)
strText = Replace$(strText, "#End If", "#" & conBl & "End If" & conAf)
strText = Replace$(strText, "Optional ", conBl & "Optional" & conAf & " ")
strText = vbCrLf & strText & vbCrLf
strJoinText(1) = " "
strJoinText(5) = ""
For i = 1 To conSpecial 'Cac keyword dac biet
strJoinText(3) = Mid$(CStr(varSpecial(i, 1)), 2)
strText = Replace$(strText, varSpecial(i, 1), Join$(strJoinText, ""))
Next
strJoinText(5) = vbCrLf
For i = 1 To conKeywordCount
strJoinText(3) = varKeyword(i, 1)
strText = Replace$(strText, " " & varKeyword(i, 1) & vbCrLf, Join$(strJoinText, ""))
Next
strJoinText(1) = vbCrLf
strJoinText(5) = " "
For i = 1 To conKeywordCount
strJoinText(3) = varKeyword(i, 1)
strText = Replace$(strText, vbCrLf & varKeyword(i, 1) & " ", Join$(strJoinText, ""))
Next
strJoinText(5) = vbCrLf
For i = 1 To conKeywordCount
strJoinText(3) = varKeyword(i, 1)
strText = Replace$(strText, vbCrLf & varKeyword(i, 1) & vbCrLf, Join$(strJoinText, ""))
Next
strJoinText(1) = " "
strJoinText(5) = " "
For i = 1 To conKeywordCount
strJoinText(3) = varKeyword(i, 1)
strText = Replace$(strText, " " & varKeyword(i, 1) & " ", Join$(strJoinText, ""))
Next
strJoinText(1) = "<hr>"
For i = 1 To conKeywordCount
strJoinText(3) = varKeyword(i, 1)
strText = Replace$(strText, "<hr>" & varKeyword(i, 1) & " ", Join$(strJoinText, ""))
Next
strText = Replace$(strText, "True,", conBl & "True" & conAf & ",")
strText = Replace$(strText, "False,", conBl & "False" & conAf & ",")
strText = Mid$(strText, 3) 'vbCrLf chua 2 ky tu
strText = Replace$(strText, conAf & " " & conBl, " ") 'Xoa bo cac dong code mau xanh
'Them </span> vao cac dong code
varSplit = Split(strText, vbCrLf)
For i = LBound(varSplit) To UBound(varSplit) 'Xu ly co nhieu trich dan don trong 1 dong
Do
j = InStr(1, CStr(varSplit(i)), conGr)
If j = 0 Then Exit Do
If InStrRev(CStr(varSplit(i)), conGr) = j Then
Do 'Xoa bo cac comment co chu mau xanh
k = InStrRev(CStr(varSplit(i)), conBl)
If 0 = k Then
Exit Do
Else
If j < k Then
strValue = Left$(varSplit(i), k - 1)
varSplit(i) = Replace$(varSplit(i), conBl, "", k, 1)
varSplit(i) = strValue & varSplit(i)
k = InStrRev(CStr(varSplit(i)), conAf)
strValue = Left$(varSplit(i), k - 1)
varSplit(i) = Replace$(varSplit(i), conAf, "", k, 1)
varSplit(i) = strValue & varSplit(i)
Else
Exit Do
End If
End If
Loop
varSplit(i) = varSplit(i) & conAf
Exit Do
End If
strValue = Left$(varSplit(i), j - 1)
varSplit(i) = Replace$(varSplit(i), conGr, "", j, 1)
varSplit(i) = strValue & varSplit(i)
Loop
Next
strText = Join$(varSplit, vbCrLf)
strText = Replace$(strText, "#qwerty", "#009900") '009900'008800
'Cac bot cac khoang trang va dau xuong dong khong can thiet
lngLen = Len(strText)
For i = 1 To lngLen
If Right$(strText, 1) = " " Then
strText = Left$(strText, Len(strText) - 1)
ElseIf Right$(strText, 2) = vbCrLf Then 'vbCrLf la 2 ky tu
strText = Left$(strText, Len(strText) - 2)
Else
Exit For
End If
Next
'Gia tri tra ve
Conv_Main = conText1 & conText2 & conText3 & conText4 & strText & conText5
End Function