Text aus Zwischenablage in Variable speichern

[turtle47]

Hi BaNnEd,

jetzt stehe ich nur vor dem Problem, dass er mir bei jedem Makro nur ein vorgegebens wort als textmarker setzt:

Den Inhalt aus der Zwischenablage in eine Variable schreiben und übergeben ist aber auch nicht so einfach, denn es könnte ja auch sein, dass z.B. eine Grafik in der Zwischenablage ist.

Folgender Code sollte den Job erledigen:

Code: Alles auswählen

Sub ConvertClipToText
Dim oClip, oClipContents, oTypes
Dim oConverter, convertedString$
Dim i%, iPlainLoc%
 
	iPlainLoc = -1 
	oClip = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
	oConverter = createUnoService("com.sun.star.script.Converter")
	oClipContents = oClip.getContents()
	oTypes = oClipContents.getTransferDataFlavors() 
	Dim msg$, iLoc%, outS
	msg = ""
	iLoc = -1
	
	For i=LBound(oTypes) To UBound(oTypes)
	If oTypes(i).MimeType = "text/plain;charset=utf-16" Then
	iPlainLoc = i
	Exit For
	End If
	Next
	
	If (iPlainLoc >= 0) Then
	    TextClipboard = oConverter.convertToSimpleType(oClipContents.getTransferData(oTypes(iPlainLoc)), com.sun.star.uno.TypeClass.STRING)
		dim document   as object
		dim dispatcher as object
		document   = ThisComponent.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		dim args1(0) as new com.sun.star.beans.PropertyValue
		args1(0).Name = "Bookmark"
		args1(0).Value = TextClipboard
		dispatcher.executeDispatch(document, ".uno:InsertBookmark", "", 0, args1())
	End If
End Sub

Viel Erfolg.

Jürgen

[turtle47]

Hallo,

kann man den Text auch so umwandeln, dass er nur BUCHSTABEN enthält, also auch keine :;,.!" etc...?

Man kann, aber was soll denn Anstelle der Satzzeichen, Sonderzeichen und Zahlen eingesetzt werden?

Jürgen

[turtle47]

Hallo BaNnEd,

Schau mal ob Du damit klar kommst.
Leerzeichen habe ich vom Filtern ausgeschlossen.

Code: Alles auswählen

Sub ConvertClipToText
Dim oClip, oClipContents, oTypes
Dim oConverter, convertedString$
Dim i%, iPlainLoc%
Dim iZeichen1 as integer
	iPlainLoc = -1 
	oClip = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
	oConverter = createUnoService("com.sun.star.script.Converter")
	oClipContents = oClip.getContents()
	oTypes = oClipContents.getTransferDataFlavors() 
	Dim msg$, iLoc%, outS
	msg = ""
	iLoc = -1
	
	For i=LBound(oTypes) To UBound(oTypes)
	If oTypes(i).MimeType = "text/plain;charset=utf-16" Then
	iPlainLoc = i
	Exit For
	End If
	Next
	
	If (iPlainLoc >= 0) Then
	    TextClipboard = oConverter.convertToSimpleType(oClipContents.getTransferData(oTypes(iPlainLoc)), com.sun.star.uno.TypeClass.STRING)
		FuncAcc = createunoservice("com.sun.star.sheet.FunctionAccess")
		
		'ab hier Satzzeichen, Sonderzeichen und Zahlen ausfiltern
		before:
		TextLeng = Len(TextClipboard)
		for i = 1 to TextLeng
		k = ASC(Mid(TextClipboard,i,1)
		if k = 32 then 'Leerzeichen überspringen
		goto godown 
		end if
		if  k < 65 or k > 90 and k < 97 or k > 122 and k < 196 or k > 252 then
		aResult = FuncAcc.callFunction("SUBSTITUTE",array(TextClipboard,CHR(k),"")) 'Zeichen ersetzen durch nichts > ""
		TextClipboard = aResult
		goto before
		end if
		godown:
		next i
		'Ende Filter
		
	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "Bookmark"
	args1(0).Value = TextClipboard
	dispatcher.executeDispatch(document, ".uno:InsertBookmark", "", 0, args1())
	End If
End Sub

Viel Spass damit.

Jürgen