-
Verfasst: Sa, 29.12.2012 11:11
----------
Code: Alles auswählen
Dim Constraint_1 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_2 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_3 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_4 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_5 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_6 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_7 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_8 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_9 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_10 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_11 as New com.sun.star.sheet.SolverConstraint
Dim Constraint_12 as New com.sun.star.sheet.SolverConstraint
Dim Constraints(12) as Object
Code: Alles auswählen
'Nun die Nebenbedingungen
Constraints() = F_get_solver_constraints_from_named_Range("Mengen")
'nachträglich die Sonderlösung für die nullte Bedingung
Constraints(0).Left = Sheet.getCellByPosition(1,64).CellAddress
Constraints(0).Operator = kleinergleich
Constraints(0).Right = Sheet.getCellByPosition(2,64).CellAddress
solv.Constraints = Constraints()
Code: Alles auswählen
Function F_get_solver_constraints_from_named_Range(S_named_Range)as Object
dim Constraints(12) as New com.sun.star.sheet.SolverConstraint 'gleich als SolverConstraint Array definieren
oDoc = ThisComponent
oNamedRanges = thiscomponent.NamedRanges
oRangeMengen = oNamedRanges.getbyname(S_named_Range)
oCellRangeMengen = oRangeMengen.ReferredCells
oCellRangeMengenRangeAddress = oCellRangeMengen.RangeAddress
nsheet = oCellRangeMengenRangeAddress.Sheet
oSheet = oDoc.Sheets(nsheet)'Tabelle auf der der Bereich benamst wurde
nSC = oCellRangeMengenRangeAddress.StartColumn
nSR = oCellRangeMengenRangeAddress.StartRow
nEC = oCellRangeMengenRangeAddress.EndColumn
nER = oCellRangeMengenRangeAddress.EndRow
counter = 1 'Zaehlung beginnt wie gesagt erst bei 1, da 0 bereits fix definiert wurde[/b]
for i = nSC to nEC
for k = nSR+1 to nER 'beginnt auch hier eine Zeile tiefer?
ocell = oSheet.getcellbyposition(i,k)
ocell2 = oSheet.getcellbyposition(i-1,k)'Zelle links neben oCell, geht das so?[/b]
'dim Constraint_counter as New com.sun.star.sheet.SolverConstraint 'Schnickschnack -> geht nicht durch Anhängen von _counter
'Redim preserve Constraints(counter) 'nicht nötig, da du mit dim Constraints(12) die Grösse schon auf 12 festgelegt hast
Constraints(counter).Left = ocell.celladdress
Constraints(counter).Operator = kleinergleich
Constraints(counter).Right = ocell2.celladdress
'Constraints(counter) = Constraint_counter 'Schnickschnack, in den drei Zeilen oberhalb zugewiesen
counter = counter + 1
next k
next i
F_get_solver_constraints_from_named_Range = Constraints
End Function
Code: Alles auswählen
oDoc = ThisComponent
oNamedRanges = thiscomponent.NamedRanges
Code: Alles auswählen
oDoc = ThisComponent
oNamedRanges = oDoc.NamedRanges
Das ist doch gerade der Vorteil! Du hast ein Feld (Array) von 0-12 Constraints, definiert als com.sun.star.sheet.SolverConstraint.Miamit vom iPad hat geschrieben:Meinst du das geht so? Schließlich hieß es im original ...
Code: Alles auswählen
.Left
.Operator
.Right
Genau. Deswegen hatte ich es in der ersten function so gemacht.Miamit vom iPad hat geschrieben: Daher wäre redim preserve doch nötig?
Code: Alles auswählen
nsheet = oCellRangeMengenRangeAddress.Sheet
oSheet = oDoc.Sheets(nsheet)'Tabelle auf der der Bereich benamst wurde
Code: Alles auswählen
F_get_solver_variables_from_named_Range("Mengen2")
Code: Alles auswählen
Dim Counter as integer' Über der Sub dimensioniert -> im ganzen Modul verfügbar
Sub AutomatischerSolver
.
.
.
Counter = 0' Nullsetzen des Counter aus der function herausgenommen
Variables() = F_get_solver_variables_from_named_Range("Mengen")
Variables() = F_get_solver_variables_from_named_Range("Mengen2")
solv.Variables = Variables()
.
.
Counter = 0' Nullsetzen des Couter aus der function herausgenommen
Constraints() = F_get_solver_constraints_from_named_Range("Mengen")
Constraints() = F_get_solver_constraints_from_named_Range("Mengen2")
solv.Constraints = Constraints()
.
.
End Sub