First of all, in making this blog, I wrote the VBA code for converting the VBA code to HTML code. I think there is already similar freeware on the net, but I like writing VBA code, so I dared to do this myself. After copying the VBA code to the clipboard, execute the following code to convert the clipboard contents to HTML. At that time, the comment and the character string are colored.
For example
VBA code
If s <> "A" Then 'Sample
->HTML code
If s <> <font color = #ff0000>"A"</font> Then <font color = #0000ff>'Sample</font>
->Display in browser
If s <> "A" Then 'Sample
Option Explicit
Sub Main()
'When using early binding that references Microsoft Forms 2.0 Object Library
'Dim Clip As DataObject
'Set Clip = New DataObject
'When using late binding that references the Microsoft Forms 2.0 Object Library
Dim Clip As Object
Set Clip = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Dim sOriginal As String
Dim sCurrent As String
Dim sHtml As String
Clip.GetFromClipboard
sOriginal = Clip.GetText
sHtml = ConvertBasicSourceToHtm(sOriginal)
Clip.SetText sHtml
Clip.PutInClipboard
Set Clip = Nothing
End Sub
Function ConvertBasicSourceToHtm(ByRef sOriginal As String) As String
ConvertBasicSourceToHtm = ""
Dim i As Long
Dim sCurrent As String
Dim lLen As Long
Const csFontTagForQuotedString As String = "<font color = #ff0000>" 'Red
Const csFontTagForComment As String = "<font color = #0000ff>" 'Blue
Const csFontTagEnd As String = "</font>"
For i = 1 To Len(sOriginal)
sCurrent = Mid(sOriginal, i, 1)
'Characters enclosed in double quotations are highlighted in red
If sCurrent = """" Then
Concat ConvertBasicSourceToHtm, csFontTagForQuotedString, lLen
Concat ConvertBasicSourceToHtm, ReplaceMarks(sCurrent), lLen
i = i + 1
sCurrent = ""
Do
sCurrent = Mid(sOriginal, i, 1)
Concat ConvertBasicSourceToHtm, ReplaceMarks(sCurrent), lLen
If sCurrent = """" Then
If Mid(sOriginal, i + 1, 1) <> """" Then
Exit Do
End If
ElseIf sCurrent = vbCr Then
Exit Do
ElseIf sCurrent = vbLf Then
Exit Do
ElseIf sCurrent = "" Then
Exit Do
End If
i = i + 1
Loop
Concat ConvertBasicSourceToHtm, csFontTagEnd, lLen
'Comments starting with a single quotation are highlighted in blue.
'Unfortunately, it does not support comments from Rem statements.
ElseIf sCurrent = "'" Then
Concat ConvertBasicSourceToHtm, csFontTagForComment, lLen
Concat ConvertBasicSourceToHtm, ReplaceMarks(sCurrent), lLen
i = i + 1
sCurrent = ""
Do
sCurrent = Mid(sOriginal, i, 1)
Concat ConvertBasicSourceToHtm, ReplaceMarks(sCurrent), lLen
If sCurrent = vbCr Then
Exit Do
ElseIf sCurrent = vbLf Then
Exit Do
ElseIf sCurrent = "" Then
Exit Do
End If
i = i + 1
Loop
Concat ConvertBasicSourceToHtm, csFontTagEnd, lLen
Else
'If it is neither a comment nor a string, simply replace the special symbols.
Concat ConvertBasicSourceToHtm, ReplaceMarks(sCurrent), lLen
End If
Next
ConvertBasicSourceToHtm = Left(ConvertBasicSourceToHtm, lLen)
End Function
Sub Concat(ByRef sAll As String, ByRef sPart As String, ByRef lTotalLength As Long)
' String concatenation of long strings with & is extremely slow,
' so you should use such logic if you frequently concatenate strings of long strings.
Dim lPartLength
lPartLength = Len(sPart)
If lPartLength = 0 Then
Exit Sub
End If
' Allocate memory redundantly because it takes the longest to allocate memory.
' Reallocate memory when it runs out of allocated memory.
If lTotalLength + lPartLength > Len(sAll) Then
sAll = sAll & Space(1000)
End If
Mid(sAll, lTotalLength + 1, lPartLength) = sPart
lTotalLength = lTotalLength + lPartLength
End Sub
Function ReplaceMarks(ByRef sOriginal As String) As String
Select Case sOriginal
Case "<"
ReplaceMarks = "<"
Case ">"
ReplaceMarks = ">"
Case " "
ReplaceMarks = " "
Case "&"
ReplaceMarks = "&"
Case vbCr
ReplaceMarks = ""
Case vbLf
ReplaceMarks = "<br>" & vbCrLf
Case Else
ReplaceMarks = sOriginal
End Select
End Function
