[SOLVED] How can I Move Access Richtext (HTML format) to PowerPoint TextFrame and retain the formatting?

How can I Move Access Richtext (HTML format) to PowerPoint TextFrame and retain the formatting?

I am building a Powerpoint Presentation using VBA code in an Access database. I need to be able to paste text that users have typed into an Access RichText Textbox into a Powerpoint slide TextFrame. I have tried numerous approaches from posts, none of which work.

Most of what I have tried either has the .... show up in the text or I get an The specified value is out of range error.

I have solved the problem in Word using the write to temp file, insert file into Word, but Powerpoint does not seem to have the needed methods. (At least everything I tried failed, or does not give the desired result.)

I would like to make this code work:

Public Sub WriteHTMLtoPowerPoint_Debug(strHTMLText As String, pptShape As PowerPoint.Shape)
    ' strHTML is Access Rich text with <Html> .... </HTML> wrapper
    
    Dim DataObj As New MSForms.DataObject
    
    DataObj.SetText strHTMLText
    DataObj.PutInClipboard
    
    ' The Paste, PasteSpecial, TextFrame, TextFrame2 all cause the  error: The specified value is out of range.
    ' HasTextFrame is true, HasText is true.  Tried deleting text then pasting.
    ' Also tried adding " " as text, then pasting.
    ' No difference between TextRange and TextRange2.  Same error.
    ' pptShape.TextFrame.TextRange.PasteSpecial ppPasteHTML, msoFalse, , , , msoFalse
    pptShape.TextFrame.TextRange.PasteSpecial DataType:=ppPasteHTML, DisplayAsIcon:=msoFalse, link:=msoFalse
    
    ' Same error.  Tried several variations. None worked.
    ' Including without (), and named parameters, DataType:=msoClipboardFormatHTML, etc.
    'pptShape.TextFrame2.TextRange.PasteSpecial (msoClipboardFormatHTML)
    
Proc_Exit:
   On Error Resume Next
   Set DataObj = Nothing

   Exit Sub

Proc_Err:
    LogError Err.Number, Err.Description, mcModuleName, "WriteHTMLtoPowerPoint", vbNullString, gcGENERAL_ERROR, False
    Resume Proc_Exit
    Resume Next
End Sub

Does any body have a working solution to this task? Do you see an error in my code?

Solution

This worked for me using the clipboard class from: https://stackoverflow.com/a/63735992/478884

Sub TestHtmlPaste()
    
    Dim myClipboard As New vbaClipboard
    Dim sRTF As String, HTML As String
    Dim ppApp As Object
    
    'HTML = "Hello <span style='color:#F00'>world</span>"
    HTML = "<div align=center>(U) Concept Approval Briefing" & _
          "for </div>  <div align=center>MISTIC DEVELOPER TEST</div>" & _
          "<div align=center>[Project Date]</div>"
    
    myClipboard.SetClipboardText HTML, "HTML Format"
    
    Set ppApp = GetObject(, "powerpoint.application") 'attach to running PPT
    ppApp.activepresentation.slides(1).Shapes(1).TextFrame.TextRange.Paste
    
End Sub