OpenOffice.info

Verfasst: **Fr, 12.02.2021 11:11**

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:

Code: Alles auswählen

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

Verfasst: **Mo, 15.02.2021 14:13**

Ich habe es jetzt nach vielen Umwegen selber rausbekommen. Der Punkt ist, dass man byte übergeben muss, nicht string. Das sieht dann so aus:

Code: Alles auswählen

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

OpenOffice.info

[gelöst] html in Zwischenablage

[gelöst] html in Zwischenablage

Re: html in Zwischenablage