Wie kann ich den formatierten Inhalt einer Textmarke kopieren?

[thomagerd]

Vielleicht könnt Ihr mir beim Lösen eines Problems helfen, das ich seit Jahren nicht in den Griff bekomme. Aus dem Dokument einer Text-Datei mit Textmarken suche ich eine bestimmte Textmarke (das klappt). Dann möchte ich den formatierten Text dieser Textmarke (und sonst nichts) in ein anderes Dokument kopieren, um ihn auszudrucken. Das klappt aber nur mit dem unformatierten string der Textmarke.

Option Explicit

Dim  oTDoc as Object			' Textdokument
Dim  oTxtCur as Object			' Textcursor
Dim  oTxt as Object					' Textobjekt
Dim  sPfad as String				' Pfad der Anwendung

Sub LesezeichenSuchen			' Textmarke suchen
REM  Pfad der Anwendung ermitteln
Dim  sDoc_URL as String			' Pfad zur Anwendung
	GlobalScope.BasicLibraries.LoadLibrary("Tools")	' Verweis auf LibreOffice-Makros
	sDoc_URL = thisComponent.getLocation()
	sPfad = DirectoryNameoutofPath(sDoc_URL,"/")	' LibreOffice-Makro

REM  Textdatei Laden
Dim  sURL as String					' URL der Textdatei
Dim  arg()
	sURL = sPfad & "/RezText.odt"
	oTDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, arg())

REM  Textmarke suchen
Dim  oBookmark as Object			' Textmarke
Dim  oTxtCur as Object			' Textcursor
Dim  sName as String			' Name der Textmarke
	sName = "Bejgli"
	If oTDoc.getBookmarks().hasByName(sName) Then
		oBookmark = oTDoc.getBookmarks().getByName(sName)
		oTxtCur = oTDoc.Text.createTextCursorByRange(oBookmark.getAnchor())
	End If

REM Verschiedene Methoden zum Anzeigen des Inhalts der Textmarke waren erfolgreich:
	MsgBox "durch den Text-Cursur: " & chr(13) & oTxtCur.string
	Msgbox "durch oBookmark.Anchor: " & chr(13) & oBookmark.getAnchor().string
Dim  oVCur as Object
	oVCur = oTDoc.getCurrentController().getViewCursor()
	oVCur.gotoRange(oBookmark.Anchor,false)
	MsgBox "durch den View-Cursor: " & chr(13) & oVCur.string
REM  Aber dabei geht natürlich die Formatierung verloren.
REM  Deshalb habe ich versucht, ein Textobjekt des Text-Cursors zu verarbeiten.
REM  Versuche mit View-Cursor und Bookmark.Anchor führten zum gleichen Ergebnis.
	oTxt = oTxtCur.Text
	Drucken					' zur Weiterverarbeitung von oTxt
End Sub

Wenn ich dann nacheinander die Absatzteile des Textobjekts der Textmarke mit geschachteltem Enumerieren durchgehe, lassen sich die Absatzteile samt Schriftattributen übertragen, aber die Übertagung beginnt nicht wie vorgesehen beim Anfang der Textmarke, sondern beim Anfang des Text-Dokumentes, und das ist mein Problem.

Sub Drucken

REM  AbsatzteileBeschreiben
Dim  oEnum as Object, oAbs as Object
Dim  oAbsTeile as Object, oAbsTl as Object, s$, s2$, s3$, s4$
	oEnum = oTxt.createEnumeration
	Do While oEnum.hasMoreElements
		oAbs = oEnum.nextElement
		if oAbs.supportsService("com.sun.star.text.Paragraph") Then
			oAbsTeile = oAbs.createEnumeration
			Do While oAbsTeile.hasMoreElements
				oAbsTl = oAbsTeile.nextElement
				if oAbsTl.TextPortionType = "Text" then
					s  = "String = " & oAbsTl.string  & chr(13)
					s2= "CharColor = " & oAbsTl.CharColor & chr(13)			' Farbwert
					s2= "CharHeight = " & oAbsTl.CharHeight & chr(13)		' Höhe der Schrift (Points)
					s3= "CharUnderline = " & oAbsTl.CharUnderline & chr(13)	' Unterstreichung  1=Strich
					s4= "CharWeight = " & oAbsTl.CharWeight & chr(13)		' Stärke der Zeichen in %
					MsgBox s & s2 & s3 & s4
				end if
			loop
		end if
	loop
End Sub

[anon73440385]

Es wäre für die Lesbarkeit hilfreich, wenn Du Programm-Code als Vorformatierten Text formatieren könntest. Vielen Dank …

[Lupp]

@thomagerd: “…lassen sich die Absatzteile samt Schriftattributen übertragen,…”
Ich habe offenbar nicht verstanden, wohin da etwas übrtragen werden soll.
Soll der Lesezeichenbereich ins erste Dokument (von dem aus der Code aufgerufen wurde) als Kopie eingefügt werden? Warum heißt die zweite Sub ‘Drucken’? …
Die Eigenschaft .Text eines TextRange oder TextCursor -Elements ist immer der Text zu dem es gehört, nicht ein “Text” den es enthält. Den gibt es als Objekt gar nicht. Ich weiß auch keinen Weg, diesen Inhalt zu instanttiieren, außer (sinngemäß), indem man ihn ins Clipboard kopiert.

[Lupp]

Das ist der Code, den ich probiert habe, und der auch funktioniert. Ich versuche die wesentlichen Dinge beisammen zu halten, weil ich sonst leicht den Überblick verliere.

Sub copyPasteBookmarkedRange
dispH   = createUnoService("com.sun.star.frame.DispatchHelper") REM Dispatch helper
doc0    = ThisComponent
cCtrl0  = doc0.CurrentController
dispPr0 = cCtrl0.Frame                           REM Dispatch provider for ThisComponent
url0    = doc0.Url
splUrl0 = Split(url0, "/") : u = Ubound(splUrl0)
foPath  = Left(url0, Len(url0)-Len(splUrl0(u)))  REM Folderpath of this document as URL
fiName1 = "RezText.odt"
url1    = foPath & fiName1                       REM Other document
doc1    = StarDesktop.loadComponentFromURL(url1, "_blank", 0, Array())
cCtrl1  = doc1.CurrentController
dispPr1 = cCtrl1.Frame                           REM Dispatch provider for other document
bmName  = "Bejgli" 
If doc1.Bookmarks.hasByName(bmName) Then
  bm      = doc1.Bookmarks.getByName(bmName)
  tCur1   = doc1.Text.createTextCursorByRange(bm.Anchor)
  oldSel1 = doc1.CurrentSelection
  cCtrl1.select(tCur1)                           REM The .uno:Copy uses the current selection.
  dispH.executeDispatch(dispPr1, ".uno:Copy", "", 0, Array())
  cCtrl1.select(oldSel)
  tCur0   = doc0.Text.createTextCursorByRange(doc0.Text.End())
  cCtrl0.select(tCur0)                           REM Define the spot for the pasting
  dispH.executeDispatch(dispPr0, ".uno:Paste", "", 0, Array())
End If
End Sub