LibreOffice-Forum

Code: Alles auswählen

Sub MultiplyWithFactor
Dim oDoc as Object
Dim oSheet as Object
Dim oCurSelection as Object
Dim mDataArraj as Variant
Dim nColCnt as Long
ReDim dMultiplier as Double
dim i as Long, j as Long
On Error resume next

oDoc=ThisComponent
oSheet = oDoc.CurrentController.ActiveSheet
oCurSelection = oDoc.getCurrentSelection()

 dMultiplier =100 ' anpassen
 mDataArraj = oCurSelection.DataArray
 nColCnt=oCurSelection.Columns.Count

 for i = lBound(mDataArraj()) to uBound(mDataArraj())
  For j=0 to nColCnt -1 
   mDataArraj(i)(j) = mDataArraj(i)(j) * dMultiplier
  next j
 next i
 oCurSelection.DataArray = mDataArraj
end Sub

Code: Alles auswählen

Sub MultiplyWithFactor
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCurSelection as Object
	Dim mDataArraj as Variant
	Dim nColCnt as Long
	ReDim dMultiplier as Double
	dim i as Long, j as Long
	On Error resume next
	
	oDoc=ThisComponent
	oCurSelection = oDoc.getCurrentSelection()
	
	dMultiplier =100 ' anpassen

	If oCurSelection.supportsService("com.sun.star.sheet.SheetCellRanges") Then
	
		For k=0 To oCurSelection.Count-1
			mDataArraj = oCurSelection(k).DataArray
			For i =0 To uBound(mDataArraj)
				For j=0 To ubound(mDataArraj(i))
					mDataArraj(i)(j) = mDataArraj(i)(j) * dMultiplier
				Next j
			Next i
			oCurSelection(k).DataArray = mDataArraj
		Next k
	Else
		mDataArraj = oCurSelection.DataArray
		For i =0 To uBound(mDataArraj)
			For j=0 To ubound(mDataArraj(i))
				mDataArraj(i)(j) = mDataArraj(i)(j) * dMultiplier
			Next j
		Next i
		oCurSelection.DataArray = mDataArraj
	End If
End Sub

Code: Alles auswählen

sub auswahl_multiplizieren

	oDoc=ThisComponent
	oCtrl=oDoc.CurrentController
	'vorhanden Auswahl merken
	oCurSel=oDoc.CurrentSelection
	'eine unbenutzte Zelle temporär für den Faktor nutzen und auswählen
	oTab=oCtrl.ActiveSheet
	oleer=oTab.queryEmptyCells
	oZelle = oleer(0).getcellbyposition(0,0)
	oZelle.Value=100
	oCtrl.select(oZelle)
	oSel=oDoc.CurrentSelection
	'Zwischenablae initialisieren
	oClip = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
	'Überträgt die Auswahl in die Zwischenablage
	oContents = oClip.setContents(oCtrl.getTransferable, Null)
	
	'ursprüngliche Auswahl wieder herstellen
	oCtrl.select(oCurSel)
	
	'Dispatcher initialisieren
	document   = oCtrl.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
	dim args(5) as new com.sun.star.beans.PropertyValue
	'Werte einfügen
	args(0).Name = "Flags"
	args(0).Value = "V"
	'Operation 1...Addition 2... Subtraktion 3... Multiplikation 4...Division
	args(1).Name = "FormulaCommand"
	args(1).Value = 3
	args(2).Name = "SkipEmptyCells"
	args(2).Value = false
	args(3).Name = "Transpose"
	args(3).Value = false
	args(4).Name = "AsLink"
	args(4).Value = false
	args(5).Name = "MoveMode"
	args(5).Value = 4
	
	dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args)
	
	'temporäre Zelle löschen
	oZelle.Clearcontents(1)
end sub