OpenOffice.info

Code: Alles auswählen

sub split_and_paste_or_paste_only
if thiscomponent.url = converttourl("pfad\zu\deinem\spezziellen\dok.sxc") then
 clipboard_split_and_paste
else
 paste_dispatcher
end if
end sub

Code: Alles auswählen

sub clipboard_split_and_paste
'15.3.2009 http://de.openoffice.info/viewtopic.php?f=2&t=23238
'Makro zum Einfügen aus der Zwischenablage
'in mehrere Spalten
'unter Benutzung der Function 'GetClipboard → siehe dort

dim osheet as object
dim nlines% , maxs% , startsp% , startze% , endsp% , endze%

tr = ";" 'Spaltentrenner

'die Zwischenablage...
alines() = split( getclipboard,chr(10))'..in Zeilen splitten.
'unter Windows geht auch: ...,chr(13)) ?

On Error goto ErrorHandler
nlines = ubound(alines())'Anzahl der Zeilen Null-basiert
dim iline(nlines)

for iz = 0 to nlines
   'Zeilenweise in Array splitten..
   iline(iz) = split( alines(iz) , tr )
   '...und maximal benötigte Spaltenanzahl ermittteln
   if maxs < ubound( iline(iz) ) then
      maxs = ubound( iline(iz) )
   endif
next iz
for iz = 0 to nlines
	atmpline = iline(iz)
	redim preserve atmpline(maxs)
	for io = ubound(iline(iz))+1 to maxs
		atmpline(io) = ""
	next io
	iline(iz) = atmpline()
next iz

'Startzelle zum Einfügen ist die  aktuell selektierte Zelle
with thiscomponent.currentselection().rangeaddress
   osheet = thisComponent.sheets(.sheet)
   startsp = .startcolumn
   startze = .startrow
end with

endsp = startsp + maxs
endze = startze + nlines

'Zielbereich festlegen
ozielbereich = osheet.getcellrangebyposition( startsp , startze , endsp , endze )

'setformulaarray statt setdataarray überschreibt nicht die Formatierungen.
ozielbereich.setdataarray(iline())
ochange = ozielbereich.createReplaceDescriptor()
	ochange.searchString = "^[0-9]"
	ochange.ReplaceString = "&" 
	ochange.SearchRegularExpression = true
	ozielbereich.replaceall(ochange)
	
	ochange.searchString = ",[0-9]+$"
	ochange.ReplaceString = "&€" 
	ochange.SearchRegularExpression = true
	ozielbereich.replaceall(ochange)
Exit sub
ErrorHandler:
paste_dispatcher

end sub

'entnommen aus "Makros für OOo" http://www.galileocomputing.de/1938?GPP=ooo
function GetClipboard
   On Error goto ErrorHandler
   Dim ClipBoardHandle as Object, DataObj as object
   Dim DataTypSeq() as object, sClipBoardString as String
   
   ClipBoardHandle = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
   DataObj = createUnoService("com.sun.star.datatransfer.XTransferable")
   DataObj = ClipBoardHandle.getContents()
   DataTypSeq = DataObj.getTransferDataFlavors()
   sClipBoardString = DataObj.getTransferData(DataTypSeq(0))
   getClipboard = sClipBoardString
   Exit function
   REM Wenn die Zwischenablage Bilder oder Objekte enthält
   REM oder leer ist:
   ErrorHandler:
   GetClipboard = ""
end function

sub paste_dispatcher
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
end sub

Code: Alles auswählen

ochange = ozielbereich.createReplaceDescriptor()
	ochange.searchString = "^[0-9]"
	ochange.ReplaceString = "&" 
	ochange.SearchRegularExpression = true
	ozielbereich.replaceall(ochange)
	
	ochange.searchString = ",[0-9]+$"
	ochange.ReplaceString = "&€" 
	ochange.SearchRegularExpression = true
	ozielbereich.replaceall(ochange)