我正在 Access 数据库中使用 VBA 代码构建 Powerpoint 演示文稿。我需要能够将用户在 Access RichText 文本框中输入的文本粘贴到 Powerpoint 幻灯片 TextFrame 中。我尝试了帖子中的多种方法，但都不起作用。
我尝试过的大多数内容要么在文本中显示 ....，要么收到指定值超出范围错误。
我已经使用写入临时文件、将文件插入Word解决了Word中的问题，但Powerpoint似乎没有所需的方法。 （至少我尝试的一切都失败了，或者没有给出想要的结果。）
我想让这段代码工作：
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
有任何机构可以解决此任务吗？您看到我的代码中有错误吗？
这对我使用剪贴板类有用：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