PDA

View Full Version : Export Rich Text Memo field to Excel Cell


Nilesmaxim
03-14-2016, 06:12 AM
Hello again. Once again, I'm in need of assistance or advice, if there's any available.

I'm trying to find a way to export a memo field using rich text formatting into an excel cell. This is as far as I got:



Public Sub export(ByVal Target As Range, ByVal sht As Worksheet)
Dim objdata As DataObject
Dim sHTML As String
Dim sSelAdd As String
Dim s As String
Dim c As Range

xlApp.EnableEvents = False
Set objdata = New DataObject
sHTML = Target.Text
sHTML = Replace(sHTML, "<div>", "")
sHTML = Replace(sHTML, "</div>", "")
sHTML = "<html>" + sHTML + "</html>"
objdata.SetText sHTML
objdata.PutInClipboard
sht.Select
Target.Select
sht.PasteSpecial Format:="Unicode Text"
xlApp.EnableEvents = True


End Sub


NOTE: to use this code, I had to set a reference to Microsoft Forms 2.0 Object Library. If the reference isn't available in your reference list, browse to c:\windows\SysWOW64\FM20.dll, and register it. (Other references needed to export: Microsoft Office 14.0 Object Library; Microsoft Excel 14.0 Object Library.)

As you can see, I've had to extract the <div></div> tags (otherwise, the resulting string would display these tags as part of the text), and encapsulate the entire field with <html></html> tags, then put the entire thing into a clipboard, and then paste the clipboard contents into the selected target. I've also had to use the active sheet's PasteSpecial method rather than the cell's PasteSpecial method, because the Cell's version of the method does not accommodate the "Format" parameter, which is why I had to use the select method for both the sheet and the range (a no-no, I know, but it's the only way I know to target a specific cell if I am forced to use the sheet's "PasteSpecial" method.)

So far, this code somewhat successfully exports the contents of an rtf memo field into an excel cell, even preserving most of the formating, except for one problem. The memo field also contains carriage return-line feed characters. This is problematic because when the data gets pasted back, Excel splits the data using the CRLF character as a sort of a cell-delimiter, so the data gets split across several cells. I suppose I could extract the <CR> character, but then all the data would appear as one very long line, making the result appear rather cryptic.


Is there a way I can preserve the contents and the formatting of rtf memo field (including CRLF's) during export to an excel cell, AND contain the entire contents into multiple lines of the same cell, not having it split across multiple cells?:banghead:

Thanks in advance for any advice you may have to offer.
jonh
03-15-2016, 08:07 AM
I'm not very knowledgeable about Excel and I can't really tell what you are trying to do just from reading the code.
And I used the Microsoft Web Browser control, so this may or may not be useful.


Take html > replace tags that generate a new line > load html into browser control > get the formatted text > copy text to cell


It doesn't work with header tags, e.g. h2, because the formatting and line breaks are obviously linked.



Private Sub CommandButton1_Click()
fmttext "<h2>foo bar</h2><i>hello</i><br /><b>world</b><p><div>have</div> a <u>nice day</u></p>", Cells(1, 1)
End Sub


Private Sub fmttext(s As String, r As Range)
'create new doc
WebBrowser1.Navigate2 "about:blank"
Do Until WebBrowser1.ReadyState = 4
DoEvents
Loop
'replace any line breaking tags with &para;
s = replaceX(s, "&amp;para;", "<h2>", "</h2>", "<br>", "<br />", "<p>", "<div>")
'remove extraneous tags
s = replaceX(s, "", "</p>", "</div>")
'create document and copy
WebBrowser1.Document.body.innerhtml = s
WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT

'paste text and replace &para chars
r.Parent.Paste r
Do
If InStr(r, "¶") Then r.Characters(InStr(r, "¶"), 1).Insert vbLf Else Exit Do
Loop
End Sub


Public Function replaceX(s1 As String, s2 As String, ParamArray rep() As Variant) As String
replaceX = s1
For Each r In rep
replaceX = Replace(replaceX, r, s2)
Next
End Function
Nilesmaxim
03-15-2016, 09:22 AM
Interesting. It appears that you are using the web control the way I was trying to use the clipboard. I'll give it a try, and if it works, I'll give you credit. To clarify what I'm trying to do is simply export the contents of a memo field into an excel cell. What complicates the issue is that the memo field is formatted with rich text, so the resulting content in the excel field after export contains extraneous tags, and it loses all of its formatting, such as bold, italic, font size, etc.

The code snippet in the original post uses the clipboard with some success. The formatting is preserved, but the line breaks are forcing the text to spread across several cells, when the entire content, including line breaks, needs to be contained within the same cell. Also, the <div> tags were creating havoc with the final text in the cell, so they had to be removed.

However I seem to be facing one small issue with your code. How do I replicate what looks like the new paragraph character? (¶ - asc: 182) That symbol is not on the North American keyboard, but you are referring to that character as a parameter in your Instr function call. Typing "[Alt]-182" gives me this: Â
jonh
03-15-2016, 09:53 AM
It’s not really rich text, it’s HTML (hyper text markup language) which is what web pages are written in hence the use of the web control.
Rich text is usually RTF (rich text format) and normally used by word processors. It has a totally different syntax.

It’s been a while since I used it for anything but as far as I remember the rich text control can use either so no bother.

The paragraph character is a special character written as &para; in html
I doubt it’s on any keyboard – it’s generally only used by word processors to show where a carriage return exists.

I got the general idea of what you were doing, but you get the html from target which is a range. As I said, I’m not very good with Excel. To me a range is usually a cell or group of cells. There is no reference to a RTF control in your code. Which confused me a little that’s all.
Nilesmaxim
03-15-2016, 10:35 AM
I agree with everything you said. The memo field is in RTF, however if I did a straight export, I see <div> tags in the result, and all formating lost. I had assumed that HTML was used in the memo field, but I've since discovered that it was indeed RTF, and somehow during the export process, the content got interpreted as html, I think, I can't be sure either.

Yes. You're correct. There was no reference to a rtf control in my code, because I wasn't using any. I referenced MS forms 2.0 in my project so that I can refer to the clipboard object. Apologies for the confusion.

Again, you're absolutely correct. That's exactly what a range is. But the content was sourced from a memo field in an access database, to be exported to an excell cell. In order to target that cell, I had to "select" it, otherwise you'd have no idea where the result would be going. I read many times that using the Select method is not recommended, but for the reason I explained in the original post. in this case, I really didn't have a choice.

In the meantime, I'm trying your code. I placed an ActiveX WebControl on the form, and made it invisible. I also had to rem out the DoEvents loop, because it was infinite (possibly because the control is invisible), and finally, I've encountered a rather cryptic Automation Error. "Trying to revoke a drop target that has not been registered". Since this is an automation error, it's difficult to understand what's going on, but the error occurred at the line
Forms!frmexport!WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT in the sub fmttext.
jonh
03-15-2016, 11:35 AM
If the doevents loop never ends something isn't right.

Check the control name is correct (sorry, it has to be said.)

Test it by running one line of code
yourwebcontrol.navigate2 "www.google.com"

If it won't load the page the control might not be installed correctly (assuming the pc is connected to the internet.)

If you go to a module and press f2, then check in the dropdown list where it says <all libraries> you should see ShDocVw.