OpenOffice.info

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

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