Results 1 to 13 of 13
  1. #1
    veejay is offline Advanced Beginner
    Windows 7 32bit Access 2007
    Join Date
    Nov 2018
    Location
    Montreal, Canada
    Posts
    46

    Question VBA code to remove font face and font size from rich text box

    I am sorry if this is considered as cross-posting but this question was in an inadequate part of the forum and I feel this would be better answered here.

    I need to remove some formatting from a rich text box (namely the font size and font face). I found a solution on stackoverflow dating from 4 years ago (here:https://stackoverflow.com/questions/...ze-not-working)

    Using the VBA code I was able to create a module and button on my form to clean up the code.
    I've been using this code for the past month without issue until yesterday. I noticed that when I have part of my text set to a different colour the code seems to be breaking after is passes over the coloured text.

    Here's the code for the module:

    Code:
    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
    And the button:



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

    Here is an example of how my unclean (raw) text looks like when it has colour in it:

    Code:
    <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 colour in it will break?</font></div>
    And here this is what happens right after clicking the button:

    Code:
    <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>
    It looks like when the module is run against the colour it doesn't close.

    The issue is only occurring with colour and never with other type of custom formatting. I'm not an expert in VBA but my understanding of the code is that the module will go over the code, look for
    Code:
    <font
    and then for face and size will remove anything between the " " so it can default back to my formatting. Since color also take place within the
    Code:
    <font
    part, I think this is what's causing the not closing tag.

    Any idea on how to add a line of code to make sure that whatever is within color="" wont be affected?

    Thanks

  2. #2
    orange's Avatar
    orange is online now Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    So this is what your 2 examples render for me in Firefox
    Click image for larger version. 

Name:	newhtml.png 
Views:	57 
Size:	6.3 KB 
ID:	36848
    What exactly do you want to see based on your example?

    I am not proficient in html, but I can work with vba if you can describe your requirement.

  3. #3
    veejay is offline Advanced Beginner
    Windows 7 32bit Access 2007
    Join Date
    Nov 2018
    Location
    Montreal, Canada
    Posts
    46
    Basically I want to create a module coupled with a button to remove the font face and size from copy pasted text in a rich text box to standardized the look of it.
    I already have a module and button which works ok in general. But I realized that it doesn't work when I have font face and color on a part of the text.

    I've included a copy of the database here: https://we.tl/t-CzgvwpKOpf

    You can see the example of the module breaking the text in Quality Form on the 5th file when you click "Clean font and size".

  4. #4
    orange's Avatar
    orange is online now Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    Is there anything wrong with record 2? It has color ??

    I know you are familiar with your application. Record 5 has minimal info.
    Here are records 4 and 5. What do you expect when processing record 5?
    Record 4 has a color parm and works???
    Click image for larger version. 

Name:	recs4And5.jpg 
Views:	50 
Size:	109.7 KB 
ID:	36852

    Any detail you an provide would be helpful.
    Your message says Arial 10, but your parameters are for Arial 2???

    I have modified form to show 2 more txtboxes for testing
    lowerleft is raw rich text of message, lower right is rich text after clean font and size
    Click image for larger version. 

Name:	revisionForTesting.PNG 
Views:	51 
Size:	86.9 KB 
ID:	36853

  5. #5
    orange's Avatar
    orange is online now Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    veejay,

    I added a record with some red text and green text.
    This is the raw text
    <div> Opinion How to drive <font color=red>home the Importance</font> of data security with company stakeholders</div>

    <div>Without a proper appreciation for data security and all that it <font
    face=Courier color="#22B14C"><strong><em>entails</em></strong></font>, you’ll find your business </div>
    This the screen showing rendered text

    Click image for larger version. 

Name:	4VeejayNewRec.PNG 
Views:	50 
Size:	45.8 KB 
ID:	36854
    This is using your original function. Seems to work with color parms in the rich text pasted into the Comments area in Courier font.

    I added a popup form on dbl click of rich text in lower right box. I changed font to georgina
    Click image for larger version. 

Name:	4VeejayrawtaextUnderlyingLowerRightText.PNG 
Views:	51 
Size:	47.9 KB 
ID:	36855

    Need more info and example if there is something specific you need.

  6. #6
    Micron is offline Virtually Inert Person
    Windows 10 Access 2016
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    some of what I read here is strange. First there's the 5 undeclared variables right at the top. Then the function parameters - none of which are typed. I thought there might be others, but after looking at the procedure a bit more, it's a little clearer, except for adding the underscores and looking for line feeds and carriage returns. So in the meantime, I'm going to just end this post while I play.
    EDIT (as I go):
    there is a line that sets the value of the function to its result: CleanRichText = strTEXT
    yet the function has no designated return value as in
    CleanRichTextA(strText, strFont, nSize) AS SOMETHING
    If it works anyway, I had no idea this could be, but would advise against it regardless.
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  7. #7
    Micron is offline Virtually Inert Person
    Windows 10 Access 2016
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    Maybe not useful to you, or maybe will show another approach.
    Code:
    Function CleanRichText(strText As String, strFont As String, nSize As Integer) As String
    Dim i As Integer
    Dim strStart As Long, strEnd As Long
    Dim strOldFont As String
    
     For i = 1 To 9 'actually, the max prior to HTML5 is 7. Versions after 4 apparently don't recognize size attribute, in favour of CSS
         strText = Replace(strText, "size=" & i, "size=" & nSize)
     Next i
    'Debug.Print strText
    strStart = 1
    Do
        strStart = InStr(strStart, strText, "font face=""")
        If Not strStart = 0 Then 'strStart becomes 0 if strEnd calculation exceeds length of string
            strStart = InStr(strStart, strText, """") + 1 'move to right of "
            strEnd = InStr(strStart, strText, """") 'find trailing " of font face attribute
            strOldFont = Mid(strText, strStart, strEnd - strStart) 'what is the font attribute?
        Else
            Exit Do
        End If
        
        If strOldFont <> strFont Then
            strText = Replace(strText, strOldFont, strFont) 'if the font attribute is not strFont, replace it with strFont
            'Debug.Print strText
        strStart = strEnd
        End If
    Loop
    
    MsgBox strText
    End Function
    At this point, the only effect I'm not sure of is how it would work with varying lengths of font name attributes that need to be replaced, e.g. Times New Roman in 1st spot followed by something shorter (or perhaps longer) that needed to be replaced, such as Arial. Reason being is that function continues from the end of a font name and searches for the next one. Meanwhile, the string is changing length, which complicates things greatly. As for not working when a color attribute is encountered, I don't understand what the failure currently is. The lack of "" around many of the attribute values might have something to do with it?

    EDIT: forgot to show the output (it's late here)
    <div><font face="Arial" size=2>So basically any sentence</font><font face="Arial" size=2 color=red>with </font><font face="Arial" size=2>a colour in it will break?</font></div>
    I hope this is just for a db and not a web page otherwise I'm certain you will have browser issues.
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  8. #8
    accesstos's Avatar
    accesstos is offline Expert
    Windows XP Access 2007
    Join Date
    Dec 2018
    Location
    Greece
    Posts
    551
    Have you ever tried RegEx object?
    Code:
    Public Function CleanRichTextRegEx(ByVal strText As String, _
                                       ByVal strFont As String, _
                                       ByVal nSize As Integer) As String
        Dim objRegEx As Object
    
        Set objRegEx = CreateObject("VBScript.RegExp")
        On Error Resume Next
        With objRegEx
            .Global = True
            'Replace font size
            .Pattern = "size=[0-9]"
            strText = .Replace(strText, " size=" & nSize)
            'Replace font face
            .Pattern = "font face=([""'])(?:[\r\n]*(?=(\\?))\2.)*?\1"
            strText = .Replace(strText, "font face=" & strFont)
        End With
        Set objRegEx = Nothing
        CleanRichTextRegEx = strText
    End Function

  9. #9
    veejay is offline Advanced Beginner
    Windows 7 32bit Access 2007
    Join Date
    Nov 2018
    Location
    Montreal, Canada
    Posts
    46
    Quote Originally Posted by orange View Post
    Need more info and example if there is something specific you need.
    Record 4 was working fine, but record 5 wasn't and not much has change.

    The problem I have is that my users are mostly copy pasting text from online sources, word documents and email into the textbox. While doing so they are importing font size, font face, other text decoration and coloured text.
    I want them to be able to retain the most important information but want the font face and size exactly the same in all comments otherwise it's a real mess when creating reports.

    Quote Originally Posted by Micron View Post
    there is a line that sets the value of the function to its result: CleanRichText = strTEXT
    yet the function has no designated return value as in
    CleanRichTextA(strText, strFont, nSize) AS SOMETHING
    If it works anyway, I had no idea this could be, but would advise against it regardless.
    I've updated the code to add the As String but it didn't change anything.

    Quote Originally Posted by Micron View Post
    Code:
    Function CleanRichText(strText As String, strFont As String, nSize As Integer) As String
     Dim i As Integer
     Dim strStart As Long, strEnd As Long
     Dim strOldFont As String
    
      For i = 1 To 9 'actually, the max prior to HTML5 is 7. Versions after 4 apparently don't recognize size attribute, in favour of CSS
          strText = Replace(strText, "size=" & i, "size=" & nSize)
      Next i
     'Debug.Print strText
    strStart = 1
     Do
         strStart = InStr(strStart, strText, "font face=""")
         If Not strStart = 0 Then 'strStart becomes 0 if strEnd calculation exceeds length of string
             strStart = InStr(strStart, strText, """") + 1 'move to right of "
             strEnd = InStr(strStart, strText, """") 'find trailing " of font face attribute
             strOldFont = Mid(strText, strStart, strEnd - strStart) 'what is the font attribute?
         Else
             Exit Do
         End If
         
         If strOldFont <> strFont Then
             strText = Replace(strText, strOldFont, strFont) 'if the font attribute is not strFont, replace it with strFont
             'Debug.Print strText
         strStart = strEnd
         End If
     Loop
    
    MsgBox strText
     End Function
    I tried your approach straightforward but on some of the comments it just doesn't work at all.



    Quote Originally Posted by accesstos View Post
    Have you ever tried RegEx object?
    Code:
    Public Function CleanRichTextRegEx(ByVal strText As String, _
                                       ByVal strFont As String, _
                                       ByVal nSize As Integer) As String
        Dim objRegEx As Object
    
        Set objRegEx = CreateObject("VBScript.RegExp")
        On Error Resume Next
        With objRegEx
            .Global = True
            'Replace font size
            .Pattern = "size=[0-9]"
            strText = .Replace(strText, " size=" & nSize)
            'Replace font face
            .Pattern = "font face=([""'])(?:[\r\n]*(?=(\\?))\2.)*?\1"
            strText = .Replace(strText, "font face=" & strFont)
        End With
        Set objRegEx = Nothing
        CleanRichTextRegEx = strText
    End Function
    I really like this approach as it's a little bit more straightforward but for some reason it doesn't always apply.

    Here's an example of a text that causing me trouble:

    This is the text as I added to the comment box before applying the cleanup (https://ibb.co/qFRZRhh)

    This is how it looks like applying my solution https://ibb.co/4MbgbNR
    This is what it looks like applying the regex solution https://ibb.co/TwBMrmH

  10. #10
    orange's Avatar
    orange is online now Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    Veejay,

    I have tried different selections and paste and they all seem to work, but I don't know details of what isn't working for you.
    I have tried the regex solution and found it works well in my tests.

    A comment with respect to your set up.

    You are updating the record, so if there are errors in the parsing and edit, you have basically wiped out the record to be tested (I think). That's why I added the 2 text boxes and popup form in my test. I was trying to preserve the recorded comment.


    What do you want recorded with comments such as the following? Paste the material between "quotes" and see what you get vs what you want.
    <div>Scientists have just packed 18 qubits—the most basic units of <font
    face="Britannic Bold" size=1>quantum computing</font>—into just six weirdly connected photons. That’s an unprecedented <font
    color="#0072BC">three</font> qubits per <font style="BACKGROUND-COLOR:#FFFF00">photon</font>, and a record for the nu<strong>m</strong>ber of qubits linked to <font
    color="#F79646">o</font>n<font color="#F79646"><strong>e</strong></font> another via quantum entan<font
    color="#22B14C"><strong>g</strong></font><font color="#ED1C24"><strong><em>l</em></strong></font>ement.</div>
    You have shown us what you get and that it isn't correct, but for clarity --what should the result be after clean up?

  11. #11
    veejay is offline Advanced Beginner
    Windows 7 32bit Access 2007
    Join Date
    Nov 2018
    Location
    Montreal, Canada
    Posts
    46
    What I want is a solution to be able to go into the records I already have, click on a single button and have the font and size cleaned up without having to manually highlight the text, set the font and size.
    I have about 6000 records to go through and more coming my way. While I don't "mind" going back on these 6000 there is just no way I can do it manually. Having this button would help me.

    The problem I have as exposed is that sometimes the text gets cut off, not in its raw form, but in the rich text display since some of the tags don't close.

    When I generate the report I use the rich text.

    In the long run I would like to set it to AfterUpdate so when my user are done with their comments it will remove unwanted font face from their comments.

    If before the clean up the text is as follow:

    This is some text in a certain font with no colour and with an inconsistent font size. But this other text here is not only bolded it has red colour applied to it while the font is set to Times New Roman.

    What I want to see is (assuming the font and size is my default one):

    This is some text in a certain font with no colour and with an inconsistent font size. But this other text here is not only bolded it has red colour applied to it while the font is set to Times New Roman.

    Does it makes sense? Right now I have to spend hours every week to change the font and size of all the comments.

    So for your comment :

    Code:
    <div>Scientists have just packed 18 qubits—the most basic units of <font
     face="Britannic Bold" size=1>quantum computing</font>—into just six weirdly connected photons. That’s an unprecedented <font
     color="#0072BC">three</font> qubits per <font style="BACKGROUND-COLOR:#FFFF00">photon</font>, and a record for the nu<strong>m</strong>ber of qubits linked to <font
     color="#F79646">o</font>n<font color="#F79646"><strong>e</strong></font> another via quantum entan<font
     color="#22B14C"><strong>g</strong></font><font color="#ED1C24"><strong><em>l</em></strong></font>ement.</div>
    Should become this in raw text :

    Code:
    <div>Scientists have just packed 18 qubits—the most basic units of <font
     face=Arial  size=2>quantum computing</font>—into just six weirdly connected photons. That’s an unprecedented <font
     color="#0072BC">three</font> qubits per <font style="BACKGROUND-COLOR:#FFFF00">photon</font>, and a record for the nu<strong>m</strong>ber of qubits linked to <font
     color="#F79646">o</font>n<font color="#F79646"><strong>e</strong></font> another via quantum entan<font
     color="#22B14C"><strong>g</strong></font><font color="#ED1C24"><strong><em>l</em></strong></font>ement.</div>


    Edit:

    Maybe regarding the regex function what I'm seeing is that it will replace short name font such as Arial, Georgia, Calibri because they are interpreted without the " " (like this: <font face=Calibri></font>) whereas Times New Roman doesn't get replace because it is surrounded by quote marks like this <font face="Times New Roman"></font> how to indicate to the regex code that it may or may not be surrounded by quotation marks?

    EDIT 2:
    I have amended the regex code to the following and believe everything is working smoothly now:
    Code:
    Public Function CleanRichTextRegEx(ByVal strText As String, _
                                       ByVal strFont As String, _
                                       ByVal nSize As Integer) As String
        Dim objRegEx As Object
        Set objRegEx = CreateObject("VBScript.RegExp")
        On Error Resume Next
        With objRegEx
            .Global = True
            'Replace font size
            .Pattern = "size=[0-9]"
            strText = .Replace(strText, " size=" & nSize)
            'Replace font face
            .Pattern = "face=([""'])(?:[\r\n]*(?=(\\?))\2.)*?\1"
            strText = .Replace(strText, "face=" & strFont)
        End With
        Set objRegEx = Nothing
        CleanRichTextRegEx = strText
    End Function

  12. #12
    orange's Avatar
    orange is online now Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    Looks good. You can certainly test your 6000 records or a sample from them and output to a separate file for inspection/verification.
    Good luck with your project and Thanks accesstos for the regex approach.

  13. #13
    accesstos's Avatar
    accesstos is offline Expert
    Windows XP Access 2007
    Join Date
    Dec 2018
    Location
    Greece
    Posts
    551
    I have amended the regex code to the following and believe everything is working smoothly now:
    Very smart amendment veejay!
    I like subtractions, in every level. :-)

    Best regards,
    John

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Msgbox font size
    By GraeagleBill in forum Access
    Replies: 7
    Last Post: 02-05-2018, 02:50 PM
  2. UI Font Size
    By bertsirkin in forum Access
    Replies: 4
    Last Post: 06-23-2017, 07:24 PM
  3. Treeview font size
    By charly.csh in forum Access
    Replies: 7
    Last Post: 03-23-2016, 05:09 PM
  4. Replies: 4
    Last Post: 08-03-2014, 10:10 PM
  5. Replies: 3
    Last Post: 07-28-2014, 03:02 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums