我一直在使用这里提供的代码: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>