文本中的颜色破坏了我的富文本清理代码

时间:2019-01-08 18:51:05

标签: access-vba

我一直在使用这里提供的代码:Access VBA programmatically setting font/size not working来清除不需要的字体和字体大小的富文本框。到目前为止,一切都很好。我一直在用粗体,斜体,下划线,突出显示进行测试,一切都很棒。

问题出在颜色上。如果我为文本添加颜色,则VBA功能会删除除彩色文本之外的所有内容,这是一个大问题,因为我需要有可能为文本添加其他颜色。

这是我访问文件中使用的另一篇文章中的代码。

Public Function CleanRichText(strTEXT, strFont, nSize)

For i = 1 To 9
    strTEXT = Replace(strTEXT, "size=" & i, "size=" & nSize)
Next i

strTEXT = Replace(strTEXT, "font face", "font_face")
strTEXT = Replace(strTEXT, "font" & Chr(13) & Chr(10) & "face", "font_face")

Do While InStr(1, strTEXT, "font_face=" & Chr(34)) > 0
    iCut1 = InStr(1, strTEXT, "font_face=" & Chr(34))
    iCut2 = InStr(iCut1 + 12, strTEXT, Chr(34))
    strLeft = Left(strTEXT, iCut1 - 1) & "font_face=Face"
    strRight = Right(strTEXT, Len(strTEXT) - iCut2)
    strTEXT = strLeft & strRight
Loop

Do While InStr(1, strTEXT, "font_face=") > 0
    iCut1 = InStr(1, strTEXT, "font_face=")
    iCut2 = InStr(iCut1 + 12, strTEXT, Chr(32))
    strLeft = Left(strTEXT, iCut1 - 1) & "font face=" & strFont & Chr(32)
    strRight = Right(strTEXT, Len(strTEXT) - iCut2)
    strTEXT = strLeft & strRight
Loop
CleanRichText = strTEXT

结束功能

这是我表单上的部分:

Private Sub CleanTextBox_Click()
    MsgBox ("Updating the comments to Arial 11pts")
    Me.NOTES = CleanRichText(Me.NOTES, Me.NOTES.FontName, 2)
End Sub

看起来代码更新一行中的某些颜色后代码开始运行时不会再次关闭。

这是应用代码之前文本的样子:

<div><font face="Times New Roman" size=3>So basically any sentence</font><font face="Times New Roman" size=3 color=red>with </font><font face="Times New Roman" size=3>a color in it will break?</font></div>

紧随其后:

<div><font face=Arial size=2>So basically any sentence </font><font face=Arial size=2 color=red>with </font><font face=Arial color in it will break?</font></div>

0 个答案:

没有答案