AW: Solver und aktives Tabellenblatt
03.10.2010 11:16:19
fcs
Hallo Patrick,
das Blatt mit der Solverberechnung muss während der Makroausführung das aktive Blatt sein.
Man kann in Excel eine Arbeitsmappe in 2 oder mehreren Fenster unterschiedlicheer Größe anzeigen. Ich hab dein Makro mal so umgestrickt, das während der Makroausführung das Solverblatt in einem kleinen Fenster ausgeführt wird und das Diagrammblatt in fast voller Größe sichtbar bleibt.
Gruß
Franz
Sub Schaltfläche2_KlickenSieAuf()
' Fenster_anpassen Makro
Dim oWindow1 As Window, oWindow2 As Window
Dim wksAktiv As Worksheet, wksSolver As Worksheet
Dim WindowHoehe As Double, WindowBreite As Double
Dim NCells As Variant
Dim ngroups As Variant
Dim n As Integer
Application.WindowState = xlMaximized
ActiveWindow.WindowState = xlMaximized
WindowHoehe = ActiveWindow.Height
WindowBreite = ActiveWindow.Width
Set wksAktiv = ActiveSheet 'Diagrammblatt mit Schaltfläche
Set wksSolver = ActiveWorkbook.Worksheets("Tabelle3")
wksSolver.Visible = True
'2. Fenster für Arbeitsmappe anzeigen
Set oWindow1 = ActiveWindow
ActiveWindow.NewWindow
Set oWindow2 = ActiveWindow
wksAktiv.Activate
ActiveWorkbook.Windows.Arrange ArrangeStyle:=xlArrangeStyleCascade
With oWindow2 'Fenster für Solverblatt
.Top = 1
.Left = 1
.Width = 0.1 * WindowBreite
.Height = 0.15 * WindowHoehe
End With
With oWindow1
.Top = 1
.Left = 1
.Width = WindowBreite
.Height = WindowHoehe
End With
oWindow1.Activate
ActiveWindow.ScrollRow = 14
'Fenster für Solver-Makroausführung aktivieren
oWindow2.Activate
NCells = wksAktiv.Range("g3")
ngroups = Round(NCells * 0.2, 0)
With wksSolver
.Activate
.Range("b3", "i" & 1 + NCells).Clear
For n = 1 To ngroups
.Range("l2:s7").Value = .Range("b" & -3 + 5 * n, "i" & -3 + 5 * n).Value
'ThisWorkbook.ActiveSheet.Range("i2:p2").Value = ThisWorkbook.ActiveSheet.Range("i1:p1"). _
Value
'ThisWorkbook.ActiveSheet.Range("i3:p6").Value = 0.5
'ThisWorkbook.ActiveSheet.Range("L2:L6").Value = ThisWorkbook.ActiveSheet.Range("L1").Value
'ThisWorkbook.ActiveSheet.Range("p2:p6").Value = ThisWorkbook.ActiveSheet.Range("p1").Value
SolverReset
SolverOptions Precision:=0.0001
SolverOptions Iterations:=100000
SolverOptions AssumeLinear:=False
SolverOptions Estimates:=2
SolverOptions Derivatives:=2
SolverOptions Scaling:=True
SolverOptions AssumeNonNeg:=True
SolverOptions Convergence:=0.0001
SolverOptions IntTolerance:=5
SolverOK SetCell:=.Range("$ab$3"), MaxMinVal:=3, ValueOf:="0", ByChange:= _
.Range("$l$3:$n$7,$p$3:$r$7")
SolverAdd CellRef:=.Range("$l$3"), Relation:=1, FormulaText:=.Range("$l$2")
SolverAdd CellRef:=.Range("$l$4"), Relation:=1, FormulaText:=.Range("$l$3")
SolverAdd CellRef:=.Range("$l$5"), Relation:=1, FormulaText:=.Range("$l$4")
SolverAdd CellRef:=.Range("$l$6"), Relation:=1, FormulaText:=.Range("$l$5")
SolverAdd CellRef:=.Range("$l$7"), Relation:=1, FormulaText:=.Range("$l$6")
SolverAdd CellRef:=.Range("$u$3:$ab$7"), Relation:=2, FormulaText:="0"
SolverSolve UserFinish:=True
.Range("b" & -2 + 5 * n, "i" & 2 + 5 * n).Value = .Range("l3:s7").Value
Next n
End With
'End
'Solverfenster wieder schliessem
oWindow2.Close
oWindow1.WindowState = xlMaximized
wksAktiv.Activate
End Sub