Su | Mo | Tu | We | Th | Fr | Sa |
---|---|---|---|---|---|---|
1 | 2 | 3 | 4 | |||
5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | 15 | 16 | 17 | 18 |
19 | 20 | 21 | 22 | 23 | 24 | 25 |
26 | 27 | 28 | 29 | 30 | 31 |
VBAで作成したプログラムを
Webなんかで公開したい場合に使うマクロを作成しました。
色を塗ったり、インデントしたりするだけの動作ですが、自動化しようと思えば
それなりのプログラムになるわけで、作成に2日間くらいかかりました。
動かし方は、
VBAで記述したコードをコピーして、
Excelの1行1列目に貼り付けします。
区切り位置設定は無しで設定する必要があります。
コピペ時の区切り位置は前回の区切り位置設定を覚えているので、
変に張り付けられてしまう場合は、一度、区切り位置設定をしないで区切り位置処理を実施します。
使ってみた感じ、まだ不完全でした。う~ん。プログラミングセンスねぇな。
仕様を決めるところで、まだ詰めが甘い。ダブルクォーテション内の関数に色が付くというところを
回避する部分に改良するべき余地がありそうです。
それとOffice2010のVBAだとWhile文とかでうっかり永久ループに入るとブレークキー Shift+E046でも止められないみたいです。もう誰かが解決策を見つけてくれているとは思いますが、自分はまだOffice2010を使い始めてひと月程度ですし、まだまだ勉強が必要ですね。
ま、Vectorとか行けば、同じようなのが、アドインとかで大それた機能として、
ありますけどね。自分流って奴もあっていいかなと思いまして。作りました。
意外と便利っす。
これも、あとで、もう少し改良しようかな。
130507
改良版に更新しました。
プログラムは以下より入手できます。
Download file
コードは以下のとおりです。
Sub VBACode2HTML()
Dim sh As Worksheet
Dim lScanRow As Long
Dim lSpaceCnt As Long
Dim strFrontStrings As String
Dim bDblQrt As Boolean
Dim lPos As Long
Dim strFeedLine As String
'課題:ダブルクォーテーションで囲われている場合は色を塗らない処理を追加する必要あり。
'①前にはSpaceやTab以外は許されず、後ろにスペースが必要なステートメント配列リスト
Dim strArrBlueTopSp(72) As String
strArrBlueTopSp(0) = "Sub "
strArrBlueTopSp(1) = "Function "
strArrBlueTopSp(2) = "Dim "
strArrBlueTopSp(3) = "ReDim "
strArrBlueTopSp(4) = "Set "
strArrBlueTopSp(5) = "If "
strArrBlueTopSp(6) = "Else If "
strArrBlueTopSp(7) = "Else "
strArrBlueTopSp(8) = "Call "
strArrBlueTopSp(9) = "While "
strArrBlueTopSp(10) = "Print "
strArrBlueTopSp(11) = "For "
strArrBlueTopSp(12) = "Debug.Print "
strArrBlueTopSp(13) = "Debug.Assert "
strArrBlueTopSp(14) = "Open "
strArrBlueTopSp(15) = "Close "
strArrBlueTopSp(16) = "On Error "
strArrBlueTopSp(17) = "On "
strArrBlueTopSp(18) = "GoSub "
strArrBlueTopSp(19) = "GoTo "
strArrBlueTopSp(20) = "Option Base "
strArrBlueTopSp(21) = "Option Compare "
strArrBlueTopSp(22) = "Option Explicit "
strArrBlueTopSp(23) = "Private "
strArrBlueTopSp(24) = "Property Get "
strArrBlueTopSp(25) = "Property Let "
strArrBlueTopSp(26) = "Property Set "
strArrBlueTopSp(27) = "Public "
strArrBlueTopSp(28) = "Put "
strArrBlueTopSp(29) = "Type "
strArrBlueTopSp(30) = "RaiseEvent "
strArrBlueTopSp(31) = "Resume "
strArrBlueTopSp(32) = "RSet "
strArrBlueTopSp(33) = "Seek "
strArrBlueTopSp(34) = "Select Case "
strArrBlueTopSp(35) = "Case "
strArrBlueTopSp(36) = "Static "
strArrBlueTopSp(37) = "Const "
strArrBlueTopSp(38) = "Declare PtrSafe "
strArrBlueTopSp(39) = "Declare "
strArrBlueTopSp(40) = "DefBool "
strArrBlueTopSp(41) = "DefByte "
strArrBlueTopSp(42) = "DefInt "
strArrBlueTopSp(43) = "DefLng "
strArrBlueTopSp(44) = "DefLngLng "
strArrBlueTopSp(45) = "DefLngPtr "
strArrBlueTopSp(46) = "DefCur "
strArrBlueTopSp(47) = "DefSng "
strArrBlueTopSp(48) = "DefDbl "
strArrBlueTopSp(49) = "DefDec "
strArrBlueTopSp(50) = "DefDate "
strArrBlueTopSp(51) = "DefStr "
strArrBlueTopSp(52) = "DefObj "
strArrBlueTopSp(53) = "DefVar "
strArrBlueTopSp(54) = "Enum "
strArrBlueTopSp(55) = "Erase "
strArrBlueTopSp(56) = "Error "
strArrBlueTopSp(57) = "Event "
strArrBlueTopSp(58) = "ByVal "
strArrBlueTopSp(59) = "ByRef "
strArrBlueTopSp(60) = "Get "
strArrBlueTopSp(61) = "GoSub "
strArrBlueTopSp(62) = "GoTo "
strArrBlueTopSp(63) = "Implements "
strArrBlueTopSp(64) = "Input "
strArrBlueTopSp(65) = "Let "
strArrBlueTopSp(66) = "Line Input "
strArrBlueTopSp(67) = "Lock "
strArrBlueTopSp(68) = "Unlock "
strArrBlueTopSp(69) = "LSet "
strArrBlueTopSp(70) = "AddressOf "
strArrBlueTopSp(71) = "#If "
strArrBlueTopSp(72) = "#Else If "
'②前には"("," ",vbTabが許され、かつ後ろにSpaceがなくてはならないステートメント配列リスト
Dim strArrBlueMidSp(3) As String
strArrBlueMidSp(0) = "ByVal "
strArrBlueMidSp(1) = "ByRef "
strArrBlueMidSp(2) = "ParameArray "
strArrBlueMidSp(3) = "Null "
'③前には"("," ",vbTabが許され、かつ後ろには、")"," ",","がなくてはならないステートメント配列リスト
Dim strArrBlueAnySpliter(5) As String
strArrBlueAnySpliter(0) = "Null"
strArrBlueAnySpliter(1) = "True"
strArrBlueAnySpliter(2) = "False"
strArrBlueAnySpliter(3) = "Nothing"
strArrBlueAnySpliter(4) = "UBound"
strArrBlueAnySpliter(5) = "LBound"
'④前にはSpaceやTab以外は許されず、かつ後ろにSpaceがあってはならない配列リスト
Dim strArrBlueTop(26) As String
strArrBlueTop(0) = "Do"
strArrBlueTop(1) = "End Function"
strArrBlueTop(2) = "End If"
strArrBlueTop(3) = "Wend"
strArrBlueTop(4) = "Next"
strArrBlueTop(5) = "Exit Function"
strArrBlueTop(6) = "Exit Sub"
strArrBlueTop(7) = "Loop"
strArrBlueTop(8) = "Do While"
strArrBlueTop(9) = "Loop While"
strArrBlueTop(10) = "Do Until"
strArrBlueTop(11) = "With"
strArrBlueTop(12) = "Else"
strArrBlueTop(13) = "End With"
strArrBlueTop(14) = "End Sub"
strArrBlueTop(15) = "On Error Resume Next"
strArrBlueTop(16) = "On Error GoTo 0"
strArrBlueTop(17) = "Option Private Module"
strArrBlueTop(18) = "End Property"
strArrBlueTop(19) = "End Type"
strArrBlueTop(20) = "End Select"
strArrBlueTop(21) = "Case Else"
strArrBlueTop(22) = "Resume Next"
strArrBlueTop(23) = "End Enum"
strArrBlueTop(24) = "Retuen"
strArrBlueTop(25) = "#Else"
strArrBlueTop(26) = "#End If"
'⑤接続句で両側にスペースやタブが許される配列リスト
Dim strArrBlueMid(23) As String
strArrBlueMid(0) = " As "
strArrBlueMid(1) = " Is "
strArrBlueMid(2) = " And "
strArrBlueMid(3) = " Imp "
strArrBlueMid(4) = " Like "
strArrBlueMid(5) = " Mod "
strArrBlueMid(6) = " Not "
strArrBlueMid(7) = " Or "
strArrBlueMid(8) = " True "
strArrBlueMid(9) = " False "
strArrBlueMid(10) = " Nothing "
strArrBlueMid(11) = " Or "
strArrBlueMid(12) = " To "
strArrBlueMid(13) = " Output "
strArrBlueMid(14) = " Each "
strArrBlueMid(15) = " In "
strArrBlueMid(16) = " Property "
strArrBlueMid(17) = " Get "
strArrBlueMid(18) = " Let "
strArrBlueMid(19) = " New "
strArrBlueMid(20) = " Input "
strArrBlueMid(21) = " AddressOf "
strArrBlueMid(22) = " Step "
strArrBlueMid(23) = " Preserve "
'⑥前には一つ以上のスペースやタブが許され、さらに前には様々な表記も許されるが、後ろにはスペースやTabは入らない配列リスト
Dim strArrBlueEnd(24) As String
strArrBlueEnd(0) = " Then"
strArrBlueEnd(1) = " True"
strArrBlueEnd(2) = " False"
strArrBlueEnd(3) = " Nothing"
strArrBlueEnd(4) = " Exit Do"
strArrBlueEnd(5) = " Exit For"
strArrBlueEnd(6) = " Exit Function"
strArrBlueEnd(7) = " Exit Property"
strArrBlueEnd(8) = " Exit Sub"
strArrBlueEnd(9) = " Then"
strArrBlueEnd(10) = " Boonlean"
strArrBlueEnd(11) = " Byte"
strArrBlueEnd(12) = " Currency"
strArrBlueEnd(13) = " Date"
strArrBlueEnd(14) = " Decimal"
strArrBlueEnd(15) = " Double"
strArrBlueEnd(16) = " Integer"
strArrBlueEnd(17) = " Long"
strArrBlueEnd(18) = " LongLong"
strArrBlueEnd(19) = " LongPtr"
strArrBlueEnd(20) = " Object"
strArrBlueEnd(21) = " Single"
strArrBlueEnd(22) = " DefObj"
strArrBlueEnd(23) = " String"
strArrBlueEnd(24) = " Variant"
Dim strArrGreenComment(1) As String
strArrGreenComment(0) = "'"
strArrGreenComment(1) = "Rem "
Set sh = ActiveSheet
lScanRow = 1
lSpaceCnt = 1
'15回連続空白行が続くか、最終行まで処理をしたら終了。
While lSpaceCnt < 15 And lScanRow < 1048561
strFeedLine = sh.Cells(lScanRow, 1).Value
'連続空白行カウント処理
If sh.Cells(lScanRow, 1).Value = "" Then
lSpaceCnt = lSpaceCnt + 1
Else
lSpaceCnt = 0
End If
'
'
'バックインデント
'
'
If strFeedLine <> "" Then
'●①前にはSpaceやTab以外は許されず、後ろにスペースやタブが許される配列リストの処理
For i = 0 To UBound(strArrBlueTopSp)
lPos = 1
While InStr(lPos, strFeedLine, strArrBlueTopSp(i), vbTextCompare) > 0
lPos = InStr(lPos, strFeedLine, strArrBlueTopSp(i), vbTextCompare)
If strArrBlueTopSp(i) = "Put " Then
strStop = "Put "
End If
bNonConv = False
bDblQrt = DblQrtChk(lPos, strFeedLine)
If bDblQrt = True Then
bNonConv = True
End If
If lPos > 1 Then
strFrontStrings = Left(strFeedLine, lPos - 1)
If Right(strFrontStrings, 1) <> " " And Right(strFrontStrings, 1) <> vbTab And Right(strFrontStrings, 1) <> "" Then
bNonConv = True
End If
End If
If bNonConv = False Then
strNewFeedLine = Left(strFeedLine, lPos - 1) & "" & _
Left(strArrBlueTopSp(i), Len(strArrBlueTopSp(i)) - 1) & "" & " " & Mid(strFeedLine, lPos + Len(strArrBlueTopSp(i)))
lPos = lPos + 29 + Len(strArrBlueTopSp(i))
Else
lPos = lPos + Len(strArrBlueTopSp(i))
End If
If bNonConv = False Then
strFeedLine = strNewFeedLine
End If
If lPos > Len(strFeedLine) Then
lPos = Len(strFeedLine)
End If
Wend
Next
'●②前には"("," ",vbTabが許され、かつ後ろにSpaceがなくてはならない配列リスト
'Dim strArrBlueMidSp(4) As String
For i = 0 To UBound(strArrBlueMidSp)
lPos = 1
While InStr(lPos, strFeedLine, strArrBlueMidSp(i), vbTextCompare) > 0
lPos = InStr(lPos, strFeedLine, strArrBlueMidSp(i), vbTextCompare)
strFrontStrings = Left(strFeedLine, lPos - 1)
bNonConv = False
bDblQrt = DblQrtChk(lPos, strFeedLine)
If bDblQrt = True Then
bNonConv = True
End If
If Right(strFrontStrings, 1) <> " " And Right(strFrontStrings, 1) <> "(" And Right(strFrontStrings, 1) <> vbTab And Right(strFrontStrings, 1) <> "" Then
bNonConv = True
End If
If bNonConv = False Then
strNewFeedLine = Left(strFeedLine, lPos - 1) & "" & _
Left(strArrBlueMidSp(i), Len(strArrBlueMidSp(i)) - 1) & "" & " " & Mid(strFeedLine, lPos + Len(strArrBlueMidSp(i)))
lPos = lPos + 29 + Len(strArrBlueMidSp(i))
Else
lPos = lPos + Len(strArrBlueMidSp(i))
End If
If bNonConv = False Then
strFeedLine = strNewFeedLine
End If
If lPos > Len(strFeedLine) Then
lPos = Len(strFeedLine)
End If
Wend
Next
'●③直前は"("," ",vbTabが許され、かつ後ろには、")"," ",","がなくてはならないが、直前直後以外は制約の無いステートメント配列リスト
'Dim strArrBlueAnySpliter(4) As String
'strArrBlueAnySpliter(0) = "Null"
For i = 0 To UBound(strArrBlueAnySpliter)
lPos = 1
While InStr(lPos, strFeedLine, strArrBlueAnySpliter(i), vbTextCompare) > 0
lPos = InStr(lPos, strFeedLine, strArrBlueAnySpliter(i), vbTextCompare)
strFrontStrings = Left(strFeedLine, lPos - 1)
If Len(strFeedLine) > lPos + Len(strArrBlueAnySpliter(i)) Then
strBackStrings = Mid(strFeedLine, lPos + Len(strArrBlueAnySpliter(i)))
Else
strBackStrings = ""
End If
bNonConv = False
bDblQrt = DblQrtChk(lPos, strFeedLine)
If bDblQrt = True Then
bNonConv = True
End If
If Right(strFrontStrings, 1) <> "(" And Right(strFrontStrings, 1) <> " " And Right(strFrontStrings, 1) <> vbTab Then
bNonConv = True
End If
If strBackStrings <> "" Then
If Left(strBackStrings, 1) <> "(" And Left(strBackStrings, 1) <> " " And Left(strBackStrings, 1) <> vbTab And Left(strBackStrings, 1) <> "," Then
bNonConv = True
End If
End If
If bNonConv = False Then
strNewFeedLine = Left(strFeedLine, lPos - 1) & "" & _
strArrBlueAnySpliter(i) & "" & Mid(strFeedLine, lPos + Len(strArrBlueAnySpliter(i)))
lPos = lPos + 29 + Len(strArrBlueAnySpliter(i))
Else
lPos = lPos + Len(strArrBlueAnySpliter(i))
End If
If bNonConv = False Then
strFeedLine = strNewFeedLine
End If
If lPos > Len(strFeedLine) Then
lPos = Len(strFeedLine)
End If
Wend
Next
'●④前にはSpaceやTab以外は許されず、かつ後ろにSpaceがあってはならない配列リスト
'Dim strArrBlueTop(26) As String
'strArrBlueTop(0) = "Do"
For i = 0 To UBound(strArrBlueTop)
lPos = 1
While InStr(lPos, strFeedLine, strArrBlueTop(i), vbTextCompare) > 0
lPos = InStr(lPos, strFeedLine, strArrBlueTop(i), vbTextCompare)
If lPos > 1 Then
strFrontStrings = Left(strFeedLine, lPos - 1)
Else
strFrontStrings = ""
End If
If Len(strFeedLine) > lPos + Len(strArrBlueTop(i)) - 1 Then
strBackStrings = Mid(strFeedLine, lPos + Len(strArrBlueTop(i)))
Else
strBackStrings = ""
End If
bNonConv = False
bDblQrt = DblQrtChk(lPos, strFeedLine)
If bDblQrt = True Then
bNonConv = True
End If
If strFrontStrings <> "" Then
If Right(strFrontStrings, 1) <> "(" And Right(strFrontStrings, 1) <> " " And Right(strFrontStrings, 1) <> vbTab Then
bNonConv = True
End If
End If
If strBackStrings <> "" Then
If Left(strBackStrings, 1) <> "(" And Left(strBackStrings, 1) <> " " And Left(strBackStrings, 1) <> vbTab And Left(strBackStrings, 1) <> "," Then
bNonConv = True
End If
End If
If bNonConv = False Then
strNewFeedLine = Left(strFeedLine, lPos - 1) & "" & _
Left(strArrBlueTop(i), Len(strArrBlueTop(i))) & "" & Mid(strFeedLine, lPos + Len(strArrBlueTop(i)))
lPos = lPos + 29 + Len(strArrBlueTop(i))
Else
lPos = lPos + Len(strArrBlueTop(i))
End If
If bNonConv = False Then
strFeedLine = strNewFeedLine
End If
If lPos > Len(strFeedLine) Then
lPos = Len(strFeedLine)
End If
Wend
Next
'●⑤接続句で両側にスペースやタブが必要な配列リスト
'Dim strArrBlueMid(22) As String
'strArrBlueMid(0) = " As "
For i = 0 To UBound(strArrBlueMid)
lPos = 1
While InStr(lPos, strFeedLine, strArrBlueMid(i), vbTextCompare) > 0
lPos = InStr(1, strFeedLine, strArrBlueMid(i), vbTextCompare)
bNonConv = False
bDblQrt = DblQrtChk(lPos, strFeedLine)
If bDblQrt = True Then
bNonConv = True
End If
If bNonConv = False Then
strNewFeedLine = Left(strFeedLine, lPos - 1) & " " & _
Mid(strArrBlueMid(i), 2, Len(strArrBlueMid(i)) - 2) & " " & Mid(strFeedLine, lPos + Len(strArrBlueMid(i)))
lPos = lPos + 29 + Len(strArrBlueMid(i))
strFeedLine = strNewFeedLine
Else
lPos = lPos + Len(strArrBlueMid(i))
End If
If lPos > Len(strFeedLine) Then
lPos = Len(strFeedLine)
End If
Wend
Next
'●⑥前には一つ以上のスペースやタブが許され、さらに前には様々な表記も許されるが、後ろにはスペースやTabは入らない配列リスト
'Dim strArrBlueEnd(24) As String
'strArrBlueEnd(0) = " Then"
For i = 0 To UBound(strArrBlueEnd)
lPos = 1
While InStr(lPos, strFeedLine, strArrBlueEnd(i), vbTextCompare) > 0
lPos = InStr(1, strFeedLine, strArrBlueEnd(i), vbTextCompare)
If lPos > 1 Then
strFrontStrings = Left(strFeedLine, lPos - 1)
Else
strFrontStrings = ""
End If
If Len(strFeedLine) > lPos + Len(strArrBlueEnd(i)) - 1 Then
strBackStrings = Mid(strFeedLine, lPos + Len(strArrBlueEnd(i)))
Else
strBackStrings = ""
End If
bNonConv = False
bDblQrt = DblQrtChk(lPos, strFeedLine)
If bDblQrt = True Then
bNonConv = True
End If
If strBackStrings <> "" Then
If Right(strFrontStrings, 1) <> " " Then
bNonConv = True
End If
End If
If bNonConv = False Then
strNewFeedLine = Left(strFeedLine, lPos - 1) & " " & _
Mid(strArrBlueEnd(i), 2, Len(strArrBlueEnd(i)) - 1) & "" & strBackStrings
lPos = lPos + 29 + Len(strArrBlueEnd(i))
Else
lPos = lPos + Len(strArrBlueEnd(i))
End If
If bNonConv = False Then
strFeedLine = strNewFeedLine
End If
If lPos > Len(strFeedLine) Then
lPos = Len(strFeedLine)
End If
Wend
Next
i = 1
n = Len(strFeedLine)
strHeader = ""
strNbsp = ""
While Mid(strFeedLine, i, 1) = " " Or Mid(strFeedLine, i, 1) = vbTab And n > 0
If Mid(strFeedLine, i, 1) = " " Then
strHeader = strHeader & " "
Else
strHeader = strHeader & vbTab
End If
strNbsp = strNbsp & " "
n = n - 1
i = i + 1
Wend
strFeedLine = Replace(strFeedLine, strHeader, strNbsp, 1, -1, vbTextCompare)
For i = 0 To UBound(strArrGreenComment)
lPos = InStr(1, strFeedLine, strArrGreenComment(i), vbTextCompare)
bNonConv = False
If lPos > 0 Then
bDblQrt = DblQrtChk(lPos, strFeedLine)
If bDblQrt = True Then
bNonConv = True
End If
End If
If lPos > 0 And bNonConv = False Then
strMidLine = Mid(strFeedLine, lPos + Len(strArrGreenComment(i)))
strMidLine = Replace(strMidLine, "#191970", "#006600", 1, -1, vbTextCompare)
strNewFeedLine = Left(strFeedLine, lPos - 1) & "" & _
strArrGreenComment(i) & strMidLine & ""
strFeedLine = strNewFeedLine
End If
Next
End If
sh.Cells(lScanRow, 2).Value = strFeedLine
'
'
'
'バックインデント
'
'
lScanRow = lScanRow + 1
Wend
End Sub
Function DblQrtChk(lChkPos As Long, strFeed As String) As Boolean
Dim lBeforePos As Long
Dim lAfterPos As Long
Dim bFindBeforeAfter As Boolean
Dim bFindAfter As Boolean
lBeforePos = 1
bFinderBeforeAfter = False
bFinderAfter = False
DblQrtChk = False
While bFindBeforeAfter = False And Len(strFeed) > lBeforePos
If InStr(lBeforePos, strFeed, """", vbTextCompare) > 0 Then
lBeforePos = InStr(lBeforePos, strFeed, """", vbTextCompare)
'先頭のダブルクォーテションが見つかっても行末なら
'着色処理を実施することにして終わらせる。
'ただし、構文エラー
If Len(strFeed) = lBeforePos Then
bFindBeforeAfter = True
ElseIf InStr(lBeforePos + 1, strFeed, """", vbTextCompare) > 0 Then
'二つ目のダブルクォーテーションがある場合の処理
'まず文字位置を記録
lAfterPos = InStr(lBeforePos + 1, strFeed, """", vbTextCompare)
'検出した2つめの文字位置のもう一文字後ろにダブルクォーテションがある場合
'終端ではなく、ダブルクォーテーションそのものを表示させるためのエスケープダブルクォーテーション
'なので、検索開始位置を lAfterPos + 2 として再検索する。
While lAfterPos <= Len(strFeed) And bFindAfter = False
If lAfterPos < Len(strFeed) Then
If Mid(strFeed, lAfterPos, 2) = """""" Then
If Len(strFeed) >= lAfterPos + 2 Then
lAfterPos = lAfterPos + 2
End If
ElseIf InStr(lAfterPos, strFeed, """", vbTextCompare) > 0 Then
lAfterPos = InStr(lAfterPos, strFeed, """", vbTextCompare)
bFindAfter = True
Else
' "" の組み合わせのみで、" としての記述がない場合は
' 2つ目はないので、着色処理 DblQrtChk = Falseのまま終了。
bFindBeforeAfter = True
DblQrtChk = True
End If
ElseIf lAfterPos = Len(strFeed) Then
If InStr(lAfterPos, strFeed, """", vbTextCompare) > 0 Then
lAfterPos = InStr(lAfterPos, strFeed, """", vbTextCompare)
bFindAfter = True
Else
' "" の組み合わせのみで、" としての記述がない場合は
' 2つ目はないので、着色処理 DblQrtChk = Falseのまま終了。
bFindBeforeAfter = True
DblQrtChk = True
End If
End If
Wend
bFindAfter = False
If lBeforePos < lChkPos And lAfterPos > lChkPos Then
DblQrtChk = True
bFindBeforeAfter = True
ElseIf lBeforePos > lChkPos Then
bFindBeforeAfter = True
Else
lBeforePos = lAfterPos + 1
End If
Else
'ダブルクォーテーションが一つだけの行は構文エラー
'見つかったことにして、
'ダブルクォーテーション位置が後ろなら着色処理 DblQrtChk = Falseのまま
'前なら、色を塗らないことにして、この関数の処理を終わらせる。
If lBeforePos < lChkPos Then
DblQrtChk = True
End If
bFindBeforeAfter = True
End If
Else
'ダブルクォーテションが見つからない場合は着色処理をするので
'DblQrtChk = Falseのまま、この関数の処理を終わらせる。
bFindBeforeAfter = True
End If
Wend
End Function