Từ code VBA tạo thành trang HTML để in màu

tuhocvba · 15/2/20

Đặt vấn đề:
Đã bao giờ bạn muốn in code VBA ra chưa? Dù cho là bạn chọn in màu thì những màu comment, hay những màu từ khóa trong VBA cũng biến thành màu đen.

Bạn cần đăng nhập để thấy đính kèm

Ở đây, tôi cài đặt máy in pdf, thiết định in màu (color), tuy nhiên sản phẩm pdf vẫn bị thành ra như thế này.
Trong khi đó, thứ tôi muốn là như thế này:

Bạn cần đăng nhập để thấy đính kèm

Cái mà các bạn đang xem, đó là code VBA đã được chuyển hóa thành html. Màn hình hiển thị color rất đúng với ý đồ của tôi.
Kết quả in html ra pdf cũng rất tốt. Màu hiển thị theo đúng ý đồ.

Bạn cần đăng nhập để thấy đính kèm

Vậy, bài toán của chúng ta, chính là từ code VBA, làm thế nào để tạo ra mã html mong muốn như trên.
Tôi không nghĩ vấn đề mà mình muốn thì chỉ có mình tôi quan tâm. Thử tìm kiếm google, thì quả nhiên cũng đã có những nhu cầu như trên đã nêu.
Các bạn có thể

Bạn cần đăng nhập để thấy link

.
Link

Bạn cần đăng nhập để thấy link

.

Tuy nhiên, tôi mong muốn, thông qua VBA, chúng ta cũng có thể tạo ra một Tool tương tự, giải quyết vấn đề nêu trên, chuyển hóa code VBA thành mã html.

vothanhthu · 15/2/20

@tuhocvba Thứ vẫn chưa hiểu hoàn toàn tại sao mình phải in màu code VBA, những đối tượng mục tiêu và trong trường hợp nào cần in?. @tuhocvba giúp Thứ hiểu với !!!

thanhphong · 15/2/20

Cái này thì có nhiều mục đích. Vì mục đích thuyết trình, vì mục đích tạo tài liệu. Chưa nói tới việc in. Đơn giản nhất như việc viết tài liệu bằng word. Các đoạn code trích dẫn trên word nếu không được xử lý thì nó sẽ như thế này.

Bạn cần đăng nhập để thấy hình ảnh

Nếu đọc như thế này thì rất khó chịu. Vì các từ khóa không hiển thị màu giống như chúng ta khi code. Tuy nhiên, nếu dữ liệu là html, thì người ta chỉ việc copy và paste vào word. Nội dung hiển thị sẽ rất đẹp mắt.

Bạn cần đăng nhập để thấy hình ảnh

Lúc này, sẽ có câu hỏi như là, tại sao chúng ta không chụp ảnh màn hình code và dán vào?
Một là, nếu chỉ thuyết trình, thì điều trên là được. Tuy nhiên khi in ra, do là hình ảnh, thì độ phân giải sẽ giảm xuống.
Hai là, nếu là hình ảnh, file chia sẻ online, thì người dùng không thể copy đoạn code để thực nghiệm lại. Nếu là Text, thì họ có thể copy code để thực nghiệm.

Nhu cầu chuyển code VBA thành mã HTML đã được nhiều người trong giới VBA quan tâm, đây không phải là vấn đề mới được đặt ra. Mình đã có thời gian trao đổi cùng một vài thành viên trên diễn đàn trước đây, hiện tại cũng đang tìm hiểu.

giaiphapvba · 15/2/20

vothanhthu nói:
@tuhocvba Thứ vẫn chưa hiểu hoàn toàn tại sao mình phải in màu code VBA, những đối tượng mục tiêu và trong trường hợp nào cần in?. @tuhocvba giúp Thứ hiểu với !!!

1. Nếu muốn in, thì người ta sẽ muốn in màu. Tức là trên giao diện soạn thảo hiển thị như thế nào, thì bản in mong muốn hiển thị như vậy. Đây là lý do đương nhiên. Nếu tất cả code đều là chữ màu đen, việc đọc code sẽ rất nhức mắt.
2. Trên trình soạn thảo code VBA hiển thị như thế nào thì bản in thể hiện đúng như thế là tốt nhất. Do đó, đối tượng sẽ là toàn bộ các từ khóa code VBA như: Do, Loop, Public, Private, Dim,... Bởi vì các từ khóa này sẽ có màu khác biệt trên trình soạn thảo code VBA. Vì vậy khi tái hiện lại trên html cũng phải thể hiện được điều này.
2. Nếu câu hỏi là tại sao muốn in, thì câu hỏi này có lẽ nằm ngoài chủ đề về VBA, không nên đặt một câu hỏi nằm ngoài chủ đề về VBA ở đây.
Tuy nhiên ở bài viết

Bạn cần đăng nhập để thấy link

, thanhphong đã đưa ra một trường hợp ví dụ tốt.

bvtvba · 16/2/20

Vấn đề chính yếu vẫn là làm sao để nhận biết được các từ khóa cần tô màu. Việc liệt kê các từ khóa này tốn rất nhiều công sức.
Dưới đây là các từ khóa mà tôi đã liệt kê ra:

Bạn cần đăng nhập để thấy hình ảnh

tuhocvba · 16/2/20

Cảm ơn các ý kiến thảo luận sôi nổi của mọi người.
Các ký tự keyword không thể một chốc lát mà đầy đủ ngay, vì vậy ban đầu ghi ra một list cần thiết trên các cột A,B,C,D rồi sau đó nếu phát sinh từ khóa mới thì tự người dùng Update vào danh sách đó.
Dưới đây là code chuyển đổi Code VBA thành Code HTML:
Module Name: Conv_Module

Mã:

Const conData As Long = 16
Const conSpecial As Long = 4
Const conFunction As Long = 18
Const conKeywordCount As Long = 145
Const conBl As String = "<span style=""color:#0000FF;"">" '0000FF,000088
Const conGr As String = "<span style=""color:#qwerty;"">" '後に#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
    
    '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

Nguồn tham khảo:

Bạn cần đăng nhập để thấy link

Euler · 16/2/20

Bạn cần đăng nhập để thấy link

nếu mỗi lần cập nhật thêm từ khóa thì còn phải vào code chỉnh sửa tăng thêm số lượng. Vì vậy hướng chỉnh sửa làm sao để mọi người chỉ cần cập nhật từ khóa, còn code thì tự động tăng giảm dựa vào số lượng từ khóa bắt được.
Module Name: Conv_Module

Mã:

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

tuhocvba · 16/2/20

Tool demo:

Bạn cần đăng nhập để thấy link

Việc cập nhật từ khóa thì tùy thuộc vào nỗ lực của mỗi người, càng thêm được nhiều từ khóa vào Sheet "TOOL" thì chương trình chạy càng chính xác.

Euler · 16/2/20

Phân tích code của

Bạn cần đăng nhập để thấy link

:

Bạn cần đăng nhập để thấy hình ảnh

tuhocvba · 16/2/20

Cải tiến: Nếu có nhiều file html, chúng ta muốn tổng hợp vào một file thì phải làm thế nào?

Bạn cần đăng nhập để thấy hình ảnh

giaiphapvba · 16/2/20

Bàn về cải tiến ở

Bạn cần đăng nhập để thấy link

:
Ta cần xây dựng một template html, ở đây tôi gọi là index.html.
Dựa vào ý tưởng cải tiến, thì index.html sẽ chia làm hai frame.
Cụ thể:

Bạn cần đăng nhập để thấy đính kèm

Như vậy code cho index sẽ là:

HTML:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN">
<html>
 <head>
  <title>tuhocvba.net</title>
 </head>

 <frameset cols="20%,*">
  <frame src="_menu.html" name="frame1">
  <frame src="test2.html" name="frame2">
 </frameset>

</html>

Code cho _menu.html có điểm chú ý, đó là khi click vào link, thì đích hiển thị là frame2.

HTML:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>List Module</title>
</head>
<body text="Black" bgcolor="White">
<basefont size="3">
tuhocvba.net<br>
<hr height="3px">
<font size="2">
　List Module<br>
<br>
　　<span>・ </span><a href="test.html" target="frame2">test</a><br>
　　<span>・ </span><a href="test2.html" target="frame2">test2</a><br>
</font>
</body>
</html>

Đến đây, chúng ta đã giải quyết xong cấu trúc code html. Vì vậy việc tạo Tool là khả thi.

Euler · 23/2/20

Như vậy phân code cố định cho _menu.html là:

HTML:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>List Module</title>
</head>
<body text="Black" bgcolor="White">
<basefont size="3">
_qwerty_<br>
<hr height="3px">
<font size="2">
　List Module<br>
<br>

Phần xây dựng thêm bằng VBA sẽ là:

HTML:

　　<span>・ </span><a href="test.html" target="frame2">test</a><br>
　　<span>・ </span><a href="test2.html" target="frame2">test2</a><br>
</font>
</body>
</html>

Tương tự: Phần code cố định cho index.html là:

HTML:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN">
<html>
 <head>
  <title>_Title_</title>
 </head>

 <frameset cols="20%,*">
  <frame src="_menu.html" name="frame1">
  <frame src="_qwerty_" name="frame2">
 </frameset>

</html>

Trong đó _qwerty_ sẽ được thay thế bằng file.html thích hợp bằng VBA.

Có nhiều cách để khai báo cả đoạn văn bản cố định đã trình bày ở trên. Tôi ví dụ bạn có thể khai báo là biến số, rồi dùng code để ghép từng dòng code ở trên cuối cùng biến số ấy có giá trị cố định như trên. Tuy nhiên việc này cực kỳ mất thời gian tỉ mẩn từng dòng code.
Có một cách nữa, đó là bạn ghi nội dung này ra một cells trên file Tool. Sau đó bạn chỉ việc gán biến số bằng giá trị của cells này. Như vậy biến số sẽ có giá trị là đoạn văn bản cố định ở trên. Nhưng việc này dễ bị lộ khi người ta đọc code.

Còn một cách khác khá mới mẻ, mà đây là điểm chính tôi muốn chia sẻ cho các bạn. Tuy nhiên, sau khi chia sẻ thì nó không còn là bí mật nữa.
Người ta có một cách rất nguy hiểm như sau, đó là tạo ra ô Textbox. Điều khó chịu là ô Textbox này lại để khuất trên UserForm.

Bạn cần đăng nhập để thấy đính kèm

Khi UserForm hiển thị, chúng ta không nhìn thấy ô textbox này. Nguy hiểm hơn là ngay cả view code, bên trong giao diện thiết kế UserForm, nếu không kéo khung UserForm rộng ra, ta không nhìn thấy ô Textbox này. Đây là một kỹ thuật giấu đơn giản mà lại rất hiệu quả.
Sau đó, tôi nhập nội dung vào thuộc tính Value của TextBox:

Bạn cần đăng nhập để thấy đính kèm

giaiphapvba · 23/2/20

Module: Make_Module

Mã:

Const conModuleName As String = "　　<span>・ </span><a href=""_qwerty_"" target=""frame2"">_uiop_</a><br>" & vbCrLf
Const conEndText As String = "</font>" & vbCrLf & "</body>" & vbCrLf & "</html>"

Sub Make_Main(ByVal strMenuText As String, ByVal strIndexText As String)
    Dim i As Long
    Dim strFileName() As String
    Dim strFilePath As String
    Dim strMenu As String
    Dim strProN As String
    Dim varOFName As Variant
    '"Select file html
    With Application
        varOFName = .GetOpenFilename(FileFilter:="File HTML (*.html;*.htm),*.html;*.htm", MultiSelect:=True, Title:="Select file HTML")
        If Not IsArray(varOFName) Then Exit Sub
        strFilePath = CStr(varOFName(LBound(varOFName)))
        strFilePath = Left$(strFilePath, InStrRev(strFilePath, .PathSeparator))
    End With
    
    ReDim strFileName(LBound(varOFName) To UBound(varOFName))
    For i = LBound(varOFName) To UBound(varOFName)
        strFileName(i) = Dir(varOFName(i))
    Next
        
    Do
        strProN = InputBox(Prompt:="Please input project name")
        If strProN = "" Then
            If MsgBox("Do you want to stop the process?", vbQuestion + vbYesNo) = vbYes Then Exit Sub
        Else
            Exit Do
        End If
    Loop
        
    'Create _Menu.html
    strMenuText = Replace$(strMenuText, "_qwerty_", strProN)
    For i = LBound(strFileName) To UBound(strFileName)
        strMenu = strMenu & conModuleName
        strMenu = Replace$(strMenu, "_qwerty_", strFileName(i))
        strMenu = Replace$(strMenu, "_uiop_", Left$(strFileName(i), InStrRev(strFileName(i), ".") - 1))
    Next
    Call Make_HTML(strMenuText & vbCrLf & strMenu & conEndText, strFilePath & "_menu.html")
    
    'Create Index.html
    strIndexText = Replace$(strIndexText, "<title>_Title_</title>", "<title>" & strProN & "</title>")
    strIndexText = Replace$(strIndexText, "_qwerty_", strFileName(LBound(strFileName)))
    Call Make_HTML(strIndexText, strFilePath & "index.html")
    
    MsgBox "Created index.html and _menu.html and completed the process.", vbInformation
End Sub

tuhocvba · 5/3/23

File _menu.html thêm stype và script để hiển thị dưới dạng treeview nhìn cho bắt mắt.

_menu.html:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<style>
 /* Remove default bullets */
ul, #myUL {
  list-style-type: none;
}

/* Remove margins and padding from the parent ul */
#myUL {
  margin: 0;
  padding: 0;
}

/* Style the caret/arrow */
.caret {
  cursor: pointer;
  user-select: none; /* Prevent text selection */
}

/* Create the caret/arrow with a unicode, and style it */
.caret::before {
  content: "\25B6";
  color: black;
  display: inline-block;
  margin-right: 6px;
}

/* Rotate the caret/arrow icon when clicked on (using JavaScript) */
.caret-down::before {
  transform: rotate(90deg);
}

/* Hide the nested list */
.nested {
  display: none;
}

/* Show the nested list when the user clicks on the caret/arrow (with JavaScript) */
.active {
  display: block;
}
</style>
<title>List Module</title>
</head>
<body text="Black" bgcolor="White">
<basefont size="3">
tuhocvba.net<br>
<hr height="3px">
<font size="2">
　List Module<br>
<br>
<ul id="myUL">
    <li><span class="caret">1-1</span>
        <ul class="nested">
            <li><a href="vidu3_4.html" target="frame2">test</a></li>
            <li><a href="table1.html" target="frame2">test2</a></li>
        </ul>
    </li>
</ul>   
</font>
<script>
var toggler = document.getElementsByClassName("caret");
var i;

for (i = 0; i < toggler.length; i++) {
  toggler[i].addEventListener("click", function() {
    this.parentElement.querySelector(".nested").classList.toggle("active");
    this.classList.toggle("caret-down");
  });
}
</script>
</body>
</html>

Kết quả:

Bạn cần đăng nhập để thấy đính kèm

Nguồn tham khảo:

Bạn cần đăng nhập để thấy link

Từ code VBA tạo thành trang HTML để in màu

tuhocvba

Administrator

vothanhthu

Guest

thanhphong

Guest

giaiphapvba

Administrator

bvtvba

Guest

tuhocvba

Administrator

Euler

Administrator

tuhocvba

Administrator

Euler

Administrator

tuhocvba

Administrator

giaiphapvba

Administrator

Euler

Administrator

giaiphapvba

Administrator

tuhocvba

Administrator