Buttonprogrammierung für Zufallsauswahl?

[howtoman]

Hi, ich hab versucht dein Problem zu programmieren =)

bei einer calc tabelle:

Ansicht -> Symbolleisten -> Formular-Steuerelemente

dann bei der Leiste "Schaltfläche" klicken ein Button erstellen, irgendwo...

Extras -> Makros-> Makros Verwalten -> OpenOffice.org basic Makros

Dann meine Makros -> Standart -> "Neu" klicken. und z.B. "Random" nennen.
Oder RandomFromCells.ods(oder deiner file name) -> Standart -> Neu -> "Random" eingeben..

Dann kommt IDE fürs makro, dort alles löschen und copypaste:

Code: Alles auswählen

Dim Sheet as Object

Sub Main
'welche tabelle? in dem Fall erste (0) für 2. Tabelle muss man 1 eingeben, usw.
Sheet = thisComponent.sheets(0)
'hier: werden die werte von A4 bis A11 zufaellig bei C4-C11 verteilt.
'und noch mal von b4-b11 bei d4-d11. Man kann auch mehrere functionen einfügen.
randValueFromRangeToRange("A4:A11", "C4:C11")
randValueFromRangeToRange("B4:B11", "D4:D11")
End Sub



Sub randValueFromRangeToRange(rangeFrom, rangeTo)
	Randomize
	CellRangeFrom = Sheet.getCellRangeByName(rangeFrom).RangeAddress
	CellRangeTo = Sheet.getCellRangeByName(rangeTo).RangeAddress

	Dim arrayFrom(CellRangeFrom.EndRow - CellRangeFrom.StartRow) as String
	Dim arrayTo(CellRangeTo.EndRow - CellRangeTo.StartRow) as String
	
	For i= CellRangeFrom.StartRow TO CellRangeFrom.EndRow
		arrayFrom(i-CellRangeFrom.StartRow)	= Sheet.getCellByPosition(CellRangeFrom.StartColumn, i).String
	Next i
	

	For ii = CellRangeTo.StartRow TO CellRangeTo.EndRow
		If Ubound(arrayFrom) = -1 Then Exit For
		
		index = Cint(Rnd*(Ubound(arrayFrom)))
		wert = arrayFrom(index)
		Sheet.getCellByPosition(CellRangeTo.StartColumn,ii).String = wert
		arrayFrom = DeleteFromArray(arrayFrom, wert)

	Next ii
	
End Sub

Function DeleteFromArray(ByVal array, wert)
	If Ubound(array) = -1 Then Exit Function
	Dim newArray()
	For Each elem IN array
		If elem <> wert Then
			elemsNow = Ubound(newArray)+1
			ReDim Preserve newArray(elemsNow)
			newArray(elemsNow) = elem
		EndIf
	Next elem

	DeleteFromArray = newArray
End Function

Dann zuruck zur Tabelle, rechtsklick auf Button -> Kontrolfeld -> erreignisse -> neben "Aktion ausführen" die "..." klicken -> makro.. RandomFromCells.ods(oder deiner file name) -> standart -> random -> main .... dann OK, OK

Dann speichern, dokument schließen, dokument öffnen.
testen.


Nicht vergessen die Makros zu aktivieren.


Und hier noch die BeispielDatei.