Hallo,
ich möchte einen String html-formatiert in die Zwischenablage bekommen.
Ich erhalte aber beim anschließenden manuellen Einfügen in ein Writer-Dokument die Meldung "gewünschtes Zwischenablageformat steht nicht zur Verfügung". Ich bin mir nicht sicher, ob man in ein Writer_Dokument nicht einfach so was einfügen darf oder ob in meine Makro was nicht stimmt.
Wobei ich zugebe, dass ich das Makro nicht durchschaue. Aber mit
aFlavor.MimeType ="text/plain;charset=utf-16" klappe es und mit
aFlavor.MimeType ="text/html;charset=utf-16" klappt es eben nicht.
Hier mein Code:
REM ***** BASIC *****
option explicit
Global sTxtCStringHT As String
Sub htmlInZwischenablage()
dim blatt
dim text
blatt = ThisComponent.CurrentController.ActiveSheet
text = "hallo <h1> test </h1>"
CopyToClipBoardHT( Text )
end sub
Sub CopyToClipBoardHT( sText )
dim oClip As Object
dim oTR As Object
' create SystemClipboard instance
oClip = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
oTR = createUnoListener("TrHT_", "com.sun.star.datatransfer.XTransferable")
' set data
oClip.setContents(oTR,Null)
sTxtCStringHT = sText
End Sub
Function TrHT_getTransferData(aFlavor as com.sun.star.datatransfer.DataFlavor)
If (aFlavor.MimeType ="text/plain;charset=utf-16") Then
TrHT_getTransferData() = sTxtCStringHT
End If
End Function
Function TrHT_getTransferDataFlavors()
Dim aFlavor As new com.sun.star.datatransfer.DataFlavor
' GEÄNDERT *******************************
' aFlavor.MimeType ="text/plain;charset=utf-16"
aFlavor.MimeType ="text/html;charset=utf-16"
aFlavor.HumanPresentableName ="Unicode-Text"
TrHT_getTransferDataFlavors() = array(aFlavor)
End Function
Function TrHT_isDataFlavorSupported(aFlavor as com.sun.star.datatransfer.DataFlavor) as Boolean
If aFlavor.MimeType ="text/plain;charset=utf-16" Then
TrHT_isDataFlavorSupported = true
Else
TrHT_isDataFlavorSupported = false
End If
End Function
Blickt da jeamd besser durch als ich?
Stefan
Zuletzt geändert von delta9 am Mo, 15.02.2021 14:14, insgesamt 1-mal geändert.
REM ***** BASIC *****
option explicit
Global uebergabe(1 to 100) As byte
sub test
' überträgt text als html in ZHwischenablage
dim text as string
text = "hallo <b> man braucht bytes </b> os ist das <h1> Das erste Kapitel</h1>"
htmlInZwischenablage(text)
end sub
Sub htmlInZwischenablage(text)
dim ii
dim kurz as byte
dim zeichen(1) as string
for ii = 1 to len(text)
zeichen(1) = mid(text,ii,1)
kurz = ASC(zeichen(1))
' msgbox ii & ": " & mid(text,ii,1) & " = " & chr(cbyte(mid(text,ii,1))) & " kurz=" & kurz
uebergabe(ii) = kurz
next ii
CopyToClipBoardHT( Text )
' Kontrole_Zwischenablage
end sub
Sub Kontrole_Zwischenablage()
dim ii
dim otypes
dim oclip
dim oClipContents
oClip = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard"
oClipContents = oClip.getContents
oTypes = oClipContents.getTransferDataFlavors
For ii=LBound(oTypes) To UBound(oTypes)
' If oTypes(i).MimeType = "text/plain;charset=utf-16" Then Exit For End If
msgbox "otypes( "& ii & "),MimeType=" & oTypes(ii).MimeType & " otypes("& ii & ").DataType.name= " & oTypes(ii).DataType.name
if ii > 10 then exit for
next
end sub
Sub CopyToClipBoardHT( sText )
dim oClip As Object
dim oTR As Object
' create SystemClipboard instance
oClip = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
oTR = createUnoListener("TrHT_", "com.sun.star.datatransfer.XTransferable")
' set data
oClip.setContents(oTR,Null)
sTxtCStringHT = sText
End Sub
Function TrHT_getTransferData(aFlavor as com.sun.star.datatransfer.DataFlavor)
If (aFlavor.MimeType ="text/html;charset=utf-16") Then
TrHT_getTransferData() = uebergabe
End If
End Function
Function TrHT_getTransferDataFlavors()
Dim aFlavor As new com.sun.star.datatransfer.DataFlavor
aFlavor.MimeType ="text/html;charset=utf-16"
aFlavor.HumanPresentableName ="Unicode-Text"
TrHT_getTransferDataFlavors() = array(aFlavor)
End Function
Function TrHT_isDataFlavorSupported(aFlavor as com.sun.star.datatransfer.DataFlavor) as Boolean
If aFlavor.MimeType ="text/html;charset=utf-16" Then
TrHT_isDataFlavorSupported = true
Else
TrHT_isDataFlavorSupported = false
End If
End Function