Ok,
also danke erst mal, dass sich überhaupt jemand mit dem Problem beschäftigt!
Ich poste also jetzt den ganzen Code:
'these variables are shared by all routines in this module
Dim ANT(3, 5) As Double
Dim VI(5) As Double
Dim PARAM(5, 5) As Double
Dim NK As Integer
Dim NK1 As Integer
Dim NST As Integer
Dim ITEXT As String
Dim ws As Object, wsfp As Object, wsfpd As Object, wsmfd As Object
Public Sub desw_execute()
' This program is based on UNIDIST developed in the group
' of Prof. Aa. Fredenslund at the Technical University of Lyngby in Denmark
' It was modified for Excel-VBA by Dr. J. Rarey, University of Oldenburg,Germany
' IMPLICIT REAL * 8(A-H,O-Z)
Dim P(50) As Double
Dim XX(5) As Double
Dim Index(50) As Integer
Dim PROD(6) As Double
Dim FEED(6) As Double
Dim FL(50) As Double
Dim FV(50) As Double
Dim FLL(50, 5) As Double
Dim T(50) As Double
Dim BMAT(50, 7, 6) As Double
Dim D(50, 6) As Double
Dim CM(6, 13) As Double
Dim Pi(5) As Double
Dim DPI(5, 6) As Double
Dim SL(50) As Double
Dim SV(50) As Double
Dim FKV(50) As Double
Dim FSTR(50, 6) As Double
' get current input sheet and set variables for output sheets
Set ws = ActiveSheet
Set wsfp = Sheets("Flux Profile")
On Error GoTo 21
Set wsfpd = Sheets("Flux Profile Diagram")
Set wsmfd = Sheets("Mole Fraction Profile Diagram")
21: On Error GoTo 0
If Not wsfpd Is Nothing Then wsfpd.Delete
If Not wsmfd Is Nothing Then wsmfd.Delete
' Clear Output-Sheets
wsfp.Cells.ClearContents
' number of components
NK = ws.Cells(5, 2)
' title text
ITEXT = ws.Cells(6, 2)
' Wilson parameters PARAM(I,J) (U(J,I)-U(I,I))
For i = 1 To NK
For N = 1 To NK
PARAM(i, N) = ws.Cells(17 + i, 1 + N)
Next N
Next i
' molar volumes (CM3/MOL) and Antoine-constants (kPa)
For i = 1 To NK
VI(i) = ws.Cells(9 + i, 2 + k)
For k = 1 To 3
ANT(k, i) = ws.Cells(9 + i, 2 + k)
Next k
Next i
For i = 1 To NK
ANT(1, i) = 2.3025851 * ANT(1, i)
ANT(2, i) = 2.3025851 * ANT(2, i)
Next i
NST = ws.Cells(25, 2)
NFEED = ws.Cells(26, 2)
NSL = ws.Cells(27, 2)
NSV = ws.Cells(28, 2)
Index(1) = 1
NSL1 = NSL + 1
NSL2 = NSL + 2
Index(NSL2 + NSV) = -NST
IK = 1
' EINGABE: DESTILLATMENGE, RUECKLAUFVERHAELTNIS; DRUCK IM KOPF UND
' SUMPF DER KOLONNE (KPA), SCHAETZWERTE FÜR DIE TEMPERATUR AM KOPF
' UND IM SUMPF DER KOLONNE (C)
DEST = ws.Cells(29, 2)
RFLX = ws.Cells(30, 2)
PT = ws.Cells(31, 2)
PB = ws.Cells(32, 2)
TT = ws.Cells(33, 2)
TB = ws.Cells(34, 2)
' FLMAX: MAXIMALE AENDERUNG DER STROEME (Z.B.0.5), DTMAX:MAXI-
' MALE TEMPERATURAENDERUNG WAEHREND DER ITERATION (Z.B.10.)
DTMAX = ws.Cells(35, 2)
FLMAX = ws.Cells(36, 2)
NK1 = NK + 1
For i = 1 To NST
P(i) = PB - (PB - PT) / CDbl(NST - 1) * CDbl(i - 1)
SL(i) = 0#
SV(i) = 0#
FKV(i) = 0#
FSTR(i, NK1) = 0#
For j = 1 To NK
FSTR(i, j) = 0#
Next j
Next i
For i = 1 To NFEED
' EINGABE DES ZULAUFBODENS, -BEDINGUNGEN UND MENGEN
' NF = ZULAUFBODEN
NF = ws.Cells(39 + i, 3)
' FKV = DAMPFANTEIL DES ZULAUFS
' FSTR(NF,I) MENGE DER KOMPONENTE I IM ZULAUF
FKV(NF) = ws.Cells(39 + i, 3)
For j = 1 To NK
FSTR(NF, j) = ws.Cells(39 + i, 3 + j)
Next j
For j = 1 To NK
FSTR(NF, NK1) = FSTR(NF, NK1) + FSTR(NF, j)
Next j
Next i
If NSL <> 0 Then
For i = 1 To NSL
' NLS = BODEN FUER DEN FLUESSIGEN SEITENSTROM
NLS = ws.Cells(51 + i, 2)
IK = IK + 1
Index(IK) = NLS
' SL = MENGE DES FLÜSSIGEN SEITENSTROMS
SL(NLS) = ws.Cells(51 + i, 3)
Next i
End If
If NSV <> 0 Then
For i = 1 To NSV
IK = IK + 1
' NVS = BODEN FUER DEN DAMPFFOERMIGEN SEITENSTROM
NVS = ws.Cells(63 + i, 2)
Index(IK) = -NVS
' SV = MENGE DES DAMPFFÖRMIGEN SEITENSTROMS
SV(NVS) = ws.Cells(63 + i, 3)
Next i
End If
' BERECHNUNG DER FLUESSIGKEITS- UND DAMPFSTROEME AUF DEN BOEDEN
' (CONSTANT MOLAL OVERFLOW)
FV(NST) = DEST + FKV(NST) * FSTR(NST, NK1)
FL(NST) = DEST + RFLX + (1# - FKV(NST)) * FSTR(NST, NK1) - SL(NST)
FV(NST - 1) = FL(NST) - FSTR(NST, NK1) + SV(NST) + SL(NST) + DEST
For ii = 3 To NST
If NST > 2 Then
i = NST + 2 - ii
FL(i) = FL(i + 1) - SL(i) + (1# - FKV(i)) * FSTR(i, NK1)
FV(i - 1) = FV(i) + SV(i) - FKV(i) * FSTR(i, NK1)
End If
Next ii
FL(1) = FL(2) - SL(1) + (1# - FKV(1)) * FSTR(1, NK1)
FL(1) = FL(1) - FV(1)
For j = 1 To NK1
FEED(j) = 0#
For i = 1 To NST
FEED(j) = FEED(j) + FSTR(i, j)
Next i
Next j
' ERSTE ABSCHAETZUNG DES TEMPERATUR- UND KONZENTRATIONSPROFILS
For i = 1 To NST
T(i) = TB + (i - 1) * (TT - TB) / NST
Next i
' IRES = EXPONENT FUER DAS ABBRUCHKRITERIUM RLIM= 10.D00**(-IRES)
IRES = ws.Cells(37, 2)
rlim = 10# ^ (-IRES)
For i = 1 To NST
For j = 1 To NK
FLL(i, j) = FEED(j) / FEED(NK1) * FL(i)
Next j
Next i
NIT = 0
res = 10# * rlim
While res > rlim
NKa = NK - 1
NIT = NIT + 1
' BERECHNUNG DER AKTIVITAETSKOEFFIZIENTEN UND DER ABLEITUNG
' NACH DER TEMPERATUR UND DER MOLMENGEN
For i = 1 To NST
For j = 1 To NK
XX(j) = FLL(i, j)
Next j
FLSUM = FL(i)
Call WILSON(T(i), XX, Pi, DPI, FLSUM)
For j = 1 To NK
For k = 1 To NKa
BMAT(i, j, k) = (DPI(j, k) - DPI(j, NK)) / P(i)
Next k
BMAT(i, j, NK) = DPI(j, NK + 1) / P(i)
BMAT(i, NK + 1, j) = Pi(j) / P(i)
Next j
Next i
'200 CONTINUE
For IK = 1 To NST
i = NST + 1 - IK
ip = 2 * NK + 1
If i = 1 Then ip = NK + 1
D(i, NK) = -1 + BMAT(i, NK + 1, NK)
For j = 1 To NKa
D(i, NK) = D(i, NK) + BMAT(i, NK + 1, j)
D(i, j) = FSTR(i, j) - FLL(i, j) * (1 + SL(i) / FL(i))
D(i, j) = D(i, j) - BMAT(i, NK1, j) * (FV(i) + SV(i))
If i <> 1 Then D(i, j) = D(i, j) + BMAT(i - 1, NK1, j) * FV(i - 1)
If i <> NST Then D(i, j) = D(i, j) + FLL(i + 1, j)
' AUFSTELLUNG DER JACOBI-MATRIX UND LOESUNG DER TRIDIAGONALEN
' MATRIX DURCH GAUSSSCHE ELIMINIERUNG
For k = 1 To NK
If i <> 1 Then CM(j, k + NK) = BMAT(i - 1, j, k) * FV(i - 1)
CM(j, k) = -BMAT(i, j, k) * (FV(i) + SV(i))
Next k
Next j
For j = 1 To NKa
CM(j, j) = CM(j, j) - 1 - SL(i) / FL(i)
Next j
For j = 1 To NK
CM(NK, j) = 0#
CM(NK, j + NK) = 0#
CM(j, ip) = D(i, j)
For k = 1 To NK
CM(NK, j) = CM(NK, j) + BMAT(i, k, j)
Next k
Next j
If i <> NST Then
For j = 1 To NKa
CM(j, ip) = CM(j, ip) - D(i + 1, j)
For k = 1 To NK
CM(j, k) = CM(j, k) - BMAT(i + 1, j, k)
Next k
Next j
End If
Call GAUSL(6, 13, NK, ip - NK, CM)
For j = 1 To NK
D(i, j) = CM(j, ip)
If i <> 1 Then
For k = 1 To NK
BMAT(i, j, k) = CM(j, k + NK)
Next k
End If
Next j
'300 CONTINUE
Next IK
For i = 2 To NST
For j = 1 To NK
For k = 1 To NK
D(i, j) = D(i, j) - BMAT(i, j, k) * D(i - 1, k)
Next k
Next j
Next i
res = 0#
' AENDERUNG DER UNABHAENGIGEN VARIABLEN NACH DER NEWTON-RAPHSON METHODE
For i = 1 To NST
Q = Abs(D(i, NK) / DTMAX)
If Q > 1# Then D(i, NK) = D(i, NK) / Q
T(i) = T(i) - D(i, NK)
D(i, NK) = 0#
FLM = FLMAX * FL(i)
For j = 1 To NKa
D(i, NK) = D(i, NK) - D(i, j)
Next j
Sum = 0#
For j = 1 To NK
Q = Abs(D(i, j) / FLM)
' BERECHNUNG DER FEHLERQUADRATSUMME
res = res + Q * Q
If Q > 1# Then D(i, j) = D(i, j) / Q
FLL(i, j) = FLL(i, j) - D(i, j)
If FLL(i, j) < 0# Then FLL(i, j) = 0#
Sum = Sum + FLL(i, j)
Next j
Q = FL(i) / Sum
For j = 1 To NK
FLL(i, j) = FLL(i, j) * Q
Next j
Next i
' WRITE (NAG,502) RES,T(1),T(NST)
' 502 FORMAT(/,'WERT DER ZIELFUNKTION=',E12.3,' TB=',E12.3,' TT=´
' 1,E12.3)
'C UEBERPRUEFUNG DES ABBRUCHKRITERIUMS
Wend
' write flux report column header
wsfp.Cells(1, 1) = "Calculation Output"
wsfp.Cells(3, 1) = "Stage"
wsfp.Cells(3, 2) = "Temperature"
wsfp.Cells(4, 2) = "°C"
wsfp.Cells(3, 3) = "Pressure"
wsfp.Cells(4, 3) = "kPa"
wsfp.Cells(3, 4) = "Total Liquid Flux"
wsfp.Cells(4, 4) = "same as in-unit"
wsfp.Cells(3, 5) = "Componentr Liquid Flux"
For i = 1 To NK
wsfp.Cells(4, 4 + i) = "comp." & i
Next i
wsfp.Cells(3, 5 + NK) = "Component Liquid Mole Fraction"
For i = 1 To NK
wsfp.Cells(4, 4 + NK + i) = "x" & i
Next i
' write flux report
For i = 1 To NST
wsfp.Cells(4 + i, 1) = i
wsfp.Cells(4 + i, 2) = T(i)
wsfp.Cells(4 + i, 3) = P(i)
wsfp.Cells(4 + i, 4) = FL(i)
Suml = 0
For j = 1 To NK
wsfp.Cells(4 + i, 4 + j) = FLL(i, j)
Suml = Suml + FLL(i, j)
Next j
For j = 1 To NK
wsfp.Cells(4 + i, 4 + NK + j) = FLL(i, j) / Suml
Next j
Next i
Worksheets("Product Streams").Cells.ClearContents
Worksheets("Product Streams").Cells(1, 1) = "Product Streams"
Worksheets("Product Streams").Cells(3, 1) = "Liquid Product Streams"
Worksheets("Product Streams").Cells(4, 1) = "stage"
Worksheets("Product Streams").Cells(4, 2) = "component streams"
For j = 1 To NSL1
i = Index(j)
Q = 1#
If i <> 1 Then Q = SL(i) / FL(i)
For k = 1 To NK
PROD(k) = Q * FLL(i, k)
Next k
Worksheets("Product Streams").Cells(4 + j, 1) = i
For k = 1 To NK
Worksheets("Product Streams").Cells(4 + j, 1 + k) = PROD(k)
Next k
Next j
Worksheets("Product Streams").Cells(4 + NSL1 + 2, 1) = "Vapor Product Streams"
Worksheets("Product Streams").Cells(4 + NSL1 + 3, 1) = "stage"
Worksheets("Product Streams").Cells(4 + NSL1 + 3, 2) = "component streams"
NSLT = NSL2 + NSV
lline = 4 + NSL1 + 3
For j = NSL2 To NSLT
lline = lline + 1
i = -Index(j)
Q = 1#
If i <> NST Then Q = SV(i) / FV(i)
Worksheets("Product Streams").Cells(lline, 1) = i
For k = 1 To NK
PROD(k) = Q * BMAT(i, NK1, k) * FV(i)
Worksheets("Product Streams").Cells(lline, 1 + k) = PROD(k)
Next k
Next j
Call format_results
Charts("Flux Profile Diagram").Activate
End Sub
Sub WILSON(TEMP, FL, Pi, DPI, FLSUM)
'DAS UNTERPROGRAMM WILSON ERLAUBT DIE BERECHNUNG DER PARTIAL-
'DRUECKE UND DER ABLEITUNG NACH DER TEMPERATUIR UND DER MOLMEN
'GEN (BASIS WILSON- UND ANTOINE-GLEICHUNG)
'DIE UEBERGABEPARAMETER HABEN DIE FOLGENDE BEDEUTUNG:
'TEMP TEMPERATUR C
'FL (I) MOLMENGEN DER KOMPONENTE I I=1,2..NK
'GAM(I) AKTIVITAETSKOEFFIZIENT BERECHNET MIT DER WILSON-GLEICHUNG
'PI(I) PARTIALDRUCK DER KOMPONENTE I
'DPI(I,J)ABLEITUNG VON PI(I) GENERATED IN WILSON
'FUER J = 1,2..NK SIND ES DIE ABLEITUNGEN NACH DEN MOLMENEGEN
'FUER J=NK+1 SIND ES DIE ABLEITUNGEN NACH DER TEMPERATUR
'IMPLICIT REAL*8 (A-H,O-Z)
Dim GAM(5), PRS(5), DPRS(5), WLAM(5, 5)
'******!! COMMON/DIST/ANT(3,5),VI(5),PARAM(5,5),NK,NK1
For i = 1 To NK
PRS(i) = Exp(ANT(1, i) - ANT(2, i) / (ANT(3, i) + TEMP))
DPRS(i) = ANT(2, i) / (ANT(3, i) + TEMP) ^ 2
Next i
TEMK = TEMP + 273.15
For i = 1 To NK
For j = 1 To NK
WLAM(i, j) = VI(j) / VI(i) * Exp(-PARAM(i, j) / TEMK)
Next j
Next i
For i = 1 To NK
A1 = 0#
A2 = 0#
A3 = 0#
A4 = 0#
For k = 1 To NK
A5 = 0#
A6 = 0#
A1 = A1 + FL(k) * WLAM(i, k)
A2 = A2 + FL(k) * WLAM(i, k) * PARAM(i, k) / TEMK ^ 2
For j = 1 To NK
A5 = A5 + FL(j) * WLAM(k, j)
A6 = A6 + FL(j) * WLAM(k, j) * PARAM(k, j) / TEMK ^ 2
Next j
A3 = A3 + FL(k) * WLAM(k, i) / A5
A4 = A4 + FL(k) * WLAM(k, i) * PARAM(k, i) / TEMK ^ 2 / A5
A4 = A4 - FL(k) * WLAM(k, i) * A6 / A5 ^ 2
Next k
GAM(i) = Exp(-Log(A1 / FLSUM) + 1# - A3)
Pi(i) = FL(i) / FLSUM * GAM(i) * PRS(i)
DPI(i, NK1) = Pi(i) * (-A2 / A1 - A4 + DPRS(i))
For L = 1 To NK
A7 = 0#
A9 = 0#
For k = 1 To NK
A8 = 0#
A9 = A9 + FL(k) * WLAM(L, k)
For j = 1 To NK
A8 = A8 + FL(j) * WLAM(k, j)
Next j
A7 = A7 + FL(k) * WLAM(k, i) * WLAM(k, L) / A8 ^ 2
Next k
DPI(i, L) = -WLAM(i, L) / A1 - WLAM(L, i) / A9 + A7
Next L
Next i
For i = 1 To NK
For L = 1 To NK
S = DPI(i, L) * FL(i)
If L = i Then S = S + 1
DPI(i, L) = PRS(i) * GAM(i) / FLSUM * S
Next L
Next i
End Sub
Sub GAUSL(ND, NCOL, N, NS, A)
' DAS UNTERPROGRAMM GAUSL LOEST N LINEARE ALGEBRAISCHE GLEICHUNGEN
' DURCH GAUSSSCHE ELIMINIERUNG
' IMPLICIT REAL*( (A-H,O-Z)
'ReDim A(ND,NCOL)
N1 = N + 1
Nt = N + NS
If N <> 1 Then
For i = 2 To N
ip = i - 1
i1 = ip
X = Abs(A(i1, i1))
For j = i To N
If Abs(A(j, i1)) > X Then
X = Abs(A(j, i1))
ip = j
End If
Next j
If ip <> i1 Then
For j = i1 To Nt
X = A(i1, j)
A(i1, j) = A(ip, j)
A(ip, j) = X
Next j
End If
For j = i To N
X = A(j, i1) / A(i1, i1)
For k = i To Nt
A(j, k) = A(j, k) - X * A(i1, k)
Next k
Next j
Next i
End If
For ip = 1 To N
i = N1 - ip
For k = N1 To Nt
A(i, k) = A(i, k) / A(i, i)
If i <> 1 Then
i1 = i - 1
For j = 1 To i1
A(j, k) = A(j, k) - A(i, k) * A(j, i)
Next j
End If
Next k
Next ip
End Sub
Private Sub format_results()
' format flux profile report sheet
Sheets("Flux Profile").Select
Range("A1").Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndx = xlAutomatic
End With
Selection.Font.Bold = True
Range("A3:O3").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Columns("B:B").Select
Selection.NumberFormat = "0.000"
Columns("C:C").Select
Selection.NumberFormat = "0.000"
Columns("D
").Select
Selection.NumberFormat = "0.00"
Columns("E:O").Select
Selection.NumberFormat = "0.00000"
Range("A3:I100").Select
' add chart
Charts.Add
Dim ser As Object
ActiveChart.ChartType = xlXYScatterLines
On Error Resume Next
For Each ser In ActiveChart.SeriesCollection
ser.Delete
Next ser
On Error GoTo 0
'select chart data
undels = ActiveChart.SeriesCollection.Count
With ActiveChart
'Total Flux Curve
.SeriesCollection.NewSeries
.SeriesCollection(undels + 1).XValues = "='" & wsfp.Name & "'!R" & CInt(5) & "C1:R" & CInt(4 + NST) & "C1"
.SeriesCollection(undels + 1).Values = "='" & wsfp.Name & "'!R" & CInt(5) & "C4:R" & CInt(4 + NST) & "C4"
.SeriesCollection(undels + 1).Name = "='" & wsfp.Name & "'!R3C4"
'Component Flux Curves
For i = 1 To NK
.SeriesCollection.NewSeries
.SeriesCollection(undels + 1 + i).XValues = "='" & wsfp.Name & "'!R" & CInt(5) & "C1:R" & CInt(4 + NST) & "C1"
.SeriesCollection(undels + 1 + i).Values = "='" & wsfp.Name & "'!R" & CInt(5) & "C" & CInt(4 + i) & ":R" & CInt(4 + NST) & "C" & CInt(4 + i)
.SeriesCollection(undels + 1 + i).Name = "='" & wsfp.Name & "'!R4C" & CInt(4 + i)
Next i
End With
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Flux Profile Diagram"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Column Profile (Flux)" & Chr(10) & ITEXT
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "stage number"
.Axes(xlValue, xlPrimery).HasTitle = True
.Axes(xlValue, xlPrimery).AxisTitle.Characters.Text = "flux (input unit)"
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "0.00"
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False
With ActiveChart.Axes(xlCategory)
.MinimumScale = 1
.MaximumScale = NST
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
For Each ser In ActiveChart.SeriesCollection
With ser.Border
.ColorIndex = 57
.Weight = xlMedium
.LineStyle = xlContinuous
End With
Next ser
Sheets("Product Streams").Select
' Mole Fraction Profile --------------------------------------------------------------------------------------------------------------------------------------------------------------------
' add chart
Charts.Add
ActiveChart.ChartType = xlXYScatterLines
On Error Resume Next
For Each ser In ActiveChart.SeriesCollection
ser.Delete
Next ser
On Error GoTo 0
'select chart data
undels = ActiveChart.SeriesCollection.Count
With ActiveChart
' Componenet mole fraction Curves
For i = 1 To NK
.SeriesCollection.NewSeries
.SeriesCollection(undels + i).XValues = "='" & wsfp.Name & "'!R" & CInt(5) & "C1: R" & CInt(4 + NST) & "C1 "
.SeriesCollection(undels + i).Values = "='" & wsfp.Name & "'!R" & CInt(5) & "C" & CInt(4 + NK + i) & ":R" & CInt(4 + NST) & "C" & CInt(4 + NK + i)
.SeriesCollection(undels + i).Name = "='" & wsfp.Name & "'!R4C" & CInt(4 + NK + i)
Next i
End With
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Mole Fraction Profile Diagram"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Column Profile (Mole Fraction)" & Chr(10) & ITEXT
.Axes(xlCategory, xlPrimery).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "mole fraction"
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "0.00"
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False
With ActiveChart.Axes(xlCategory)
.MinimumScale = 1
.MaximumScale = NST
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
For Each ser In ActiveChart.SeriesCollection
With ser.Border
.ColorIndex = 57
.Weight = xlMedium
.LineStyle = xlContinuous
End With
Next ser
Sheets("Product Streams").Select
Range("A1").Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Range("A3").Select
End Sub
Public Sub desw_prepare_sheets()
' On Error Resume Next
' Sheets("Flux Profile").Add
' Sheets("product Streams").Add
' Sheets("desw_in").Add
' On Error GoTo 0
Sheets("desw_in").Select
Cells.Select
Selection.Clear
With ws
.Cells(1, 1) = "Distillation (Naphtali-Sandholm)Using the Wilson-Model"
.Cells(2, 1) = "based on code given in 'Grundoperationen' (Gmehling,Brehm)"
.Cells(4, 1) = "General Information"
.Cells(5, 1) = "Number of components:"
.Cells(6, 1) = "Title"
.Cells(8, 1) = "Pure Component Data"
.Cells(9, 1) = "Molar volume, Antoine constants (P [kPa] = 10^(A-B/(C+T[°C]))"
.Cells(9, 2) = "vL"
.Cells(9, 3) = "A"
.Cells(9, 4) = "B"
.Cells(9, 5) = "C"
.Cells(16, 1) = "Interaction Parameters (Wilson,K)"
.Cells(17, 2) = "1"
.Cells(17, 3) = "2"
.Cells(17, 4) = "3"
.Cells(17, 5) = "4"
.Cells(17, 6) = "5"
.Cells(18, 1) = "1"
.Cells(19, 1) = "2"
.Cells(20, 1) = "3"
.Cells(21, 1) = "4"
.Cells(22, 1) = "5"
.Cells(18, 2) = "0"
.Cells(19, 3) = "0"
.Cells(20, 4) = "0"
.Cells(21, 5) = "0"
.Cells(22, 6) = "0"
.Cells(24, 1) = "Column Configuration (Stage 1 is the Reboiler)"
.Cells(25, 1) = "Number of stages (max. 50)"
.Cells(26, 1) = "Number of feeds"
.Cells(27, 1) = "Number of liquid side streams"
.Cells(28, 1) = "Number of vapor side streams"
.Cells(29, 1) = "Destillate flux"
.Cells(30, 1) = "Reflux ratio"
.Cells(31, 1) = "Top pressure (kPa)"
.Cells(32, 1) = "Bottom pressure (kPa)"
.Cells(33, 1) = "Top temperature estimate (C)"
.Cells(34, 1) = "Bottom temperture estimate (C)"
.Cells(35, 1) = "FLMAX"
.Cells(36, 1) = "DTMAX"
.Cells(37, 1) = "Exponent of convergence criterion"
.Cells(39, 1) = "Feeds"
.Cells(39, 2) = "stage"
.Cells(39, 3) = "q"
.Cells(39, 4) = "n1"
.Cells(39, 5) = "n2"
.Cells(39, 6) = "n3"
.Cells(39, 7) = "n4"
.Cells(39, 8) = "n5"
.Cells(40, 1) = "1"
.Cells(41, 1) = "2"
.Cells(42, 1) = "3"
.Cells(43, 1) = "4"
.Cells(44, 1) = "5"
.Cells(45, 1) = "6"
.Cells(46, 1) = "7"
.Cells(47, 1) = "8"
.Cells(48, 1) = "9"
.Cells(49, 1) = "10"
End With
Range("A1").Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Range("A1:F1").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("A4:F4").Select
With Selection.Interior
.ColorIndex = 33
.Pattern = xlSolid
End With
Range("A8:F8").Select
With Selection.Interior
.ColorIndex = 33
.Pattern = xlSolid
End With
Range("A16:F16").Select
With Selection.Interior
.ColorIndex = 33
.Pattern = xlSolid
End With
Range("A24:F24").Select
With Selection.Interior
.ColorIndex = 33
.Pattern = xlSolid
End With
Range("A39:H39").Select
With Selection.Interior
.ColorIndex = 33
.Pattern = xlSolid
End With
Range("A5:A6").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("A9:A14").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("A17:A22").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("B17:F17").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("A25:A37").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("A40:A49").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("B18:F22").Select
Selection.NumberFormat = "0.0000"
Range("B18").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("C19").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("D20").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("E21").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("F22").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
ActiveWindow.ScrollRow = 1
Range("A1:F1").Select
Selection.Interior.ColorIndex = 37
Selection.Interior.ColorIndex = 33
Range("A2").Select
Selection.Font.Italic = True
Range("H7").Select
Columns("A:A").ColumnWidth = 27.89
Columns("B:I").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("A10").Select
ActiveCell.FormulaR1C1 = "1"
Range("A11").Select
ActiveCell.FormulaR1C1 = "2"
Range("A12").Select
ActiveCell.FormulaR1C1 = "3"
Range("A13").Select
ActiveCell.FormulaR1C1 = "4"
Range("A14").Select
ActiveCell.FormulaR1C1 = "5"
Range("B15").Select
ActiveWindow.ScrollRow = 7
End Sub
