[blue]Option Explicit
Private Declare Function _
RegisterClipboardFormat _
Lib "user32" _
Alias "RegisterClipboardFormatA" _
(ByVal lpString As String) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cbLength As Long)
Dim m_cfHTMLClipFormat As Long
Const RegHtml As String = "HTML Format"
Private Const m_sDescription = _
"Version:1.0" & vbCrLf & _
"StartHTML:aaaaaaaaaa" & vbCrLf & _
"EndHTML:bbbbbbbbbb" & vbCrLf & _
"StartFragment:cccccccccc" & vbCrLf & _
"EndFragment:dddddddddd" & vbCrLf
Public Sub test()
InitHTMLFormat
PutHTMLClipboard "<B>Test</B> Spoon" ' Obviously your source would be contents of cells from sheet
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.PasteSpecial ppPasteHTML
End Sub
Private Sub InitHTMLFormat()
m_cfHTMLClipFormat = RegisterClipboardFormat(RegHtml)
End Sub
' Thanks to KB274326
Private Sub PutHTMLClipboard(sHtmlFragment As String, _
Optional sContextStart As String = "<HTML><BODY>", _
Optional sContextEnd As String = "</BODY></HTML>")
Dim sData As String
If m_cfHTMLClipFormat = 0 Then Exit Sub
' Build HTML fragment header required by clipboard (and consuming apps)
' Add the starting and ending tags for the HTML fragment
sContextStart = sContextStart & "<!--StartFragment -->"
sContextEnd = "<!--EndFragment -->" & sContextEnd
'Build the HTML given the description, the fragment and the context.
'And, replace the offset place holders in the description with values
'for the offsets of StartHMTL, EndHTML, StartFragment and EndFragment.
sData = m_sDescription & sContextStart & sHtmlFragment & sContextEnd
sData = Replace(sData, "aaaaaaaaaa", _
Format(Len(m_sDescription), "0000000000"))
sData = Replace(sData, "bbbbbbbbbb", Format(Len(sData), "0000000000"))
sData = Replace(sData, "cccccccccc", Format(Len(m_sDescription & _
sContextStart), "0000000000"))
sData = Replace(sData, "dddddddddd", Format(Len(m_sDescription & _
sContextStart & sHtmlFragment), "0000000000"))
'Add the HTML code to the clipboard
If CBool(OpenClipboard(0)) Then
Dim hMemHandle As Long, lpData As Long
hMemHandle = GlobalAlloc(0, Len(sData) + 10)
If CBool(hMemHandle) Then
lpData = GlobalLock(hMemHandle)
If lpData <> 0 Then
CopyMemory ByVal lpData, ByVal sData, Len(sData)
GlobalUnlock hMemHandle
EmptyClipboard
SetClipboardData m_cfHTMLClipFormat, hMemHandle
End If
End If
Call CloseClipboard
End If
End Sub[/blue]