quellcode

Sub BerechnungButton_Click()
Dim shapeCount As Integer
Dim myShape As Shape
Dim shapeCounter As Integer
Dim myPageNumber As Integer
Dim propkWert As String
Dim kWert As Double
Dim result As Double
Dim dichte As Double
Dim lambdal As Double
Dim Rohrdruckgefällel As Double
Dim rohrrauigkeit As Double
Dim luftdr As Double
Dim myShapeCellExists As Integer
Dim Druckverlust1 As Double
Dim propDuctLength As String
Dim rohrlaenge As Double
Dim DuctLength As Integer
Dim DuctWidth As Integer
Dim propZetaWert As String
Dim ZetaWert As Double
Dim result1 As Integer
Dim result2 As Integer
Dim druckzeta As Double
Dim Luftgeschwindigkeit As Double
Dim druckverlusteinbauten1 As Double
Dim Rohrinnendurchmesser As Double
Dim prophydrDurchmesser As String
Dim druckverlust2 As Double
Dim Luftgeschwindigkeit1 As Double
Dim intZeilen As Integer
Dim rowZeile As Row
Dim result3 As Double
' es gibt nur eine Page, deshalb Nummer=0
myPageNumber = 1
shapeCount = ActiveDocument.Pages(myPageNumber).Shapes.Count
propkWert = "Prop.kWert"
prophydrDurchmesser = "Prop.hydrDurchmesser"
' laufe über alle Shapes
For shapeCounter = 1 To shapeCount
' prüfe, ob Shape Benutzerdwefinierte Eigenschaften besitzt
If ActiveDocument.Pages(myPageNumber).Shapes(shapeCounter).SectionExists(visSectionProp, _
True) = True _
Then
Set myShape = ActiveDocument.Pages(myPageNumber).Shapes(shapeCounter)
If myShape.CellExists(propkWert, True) = True _
Then
' setze k-Wert in Shape als Text
' myShape.Text = "k-Wert = " & myShape.Cells(propkWert)
' berechne k-Wert für Shape
kWert = myShape.Cells(propkWert)
dichte = Dichte_rF(Temperatur1.Value, Luftfeuchte1.Value, Luftdruck.Value)
rohrinnend = myShape.Cells("Prop.hydrDurchmesser").result("mm")
Rohrinnendurchmesser = myShape.Cells("Prop.hydrDurchmesser").result("mm")
lambdal = lambda(kWert, rohrinnend, Volumenstrom.Value, Temperatur1.Value, dichte)
Rohrdruckgefällel = rohrdruckgefälle(Volumenstrom, rohrinnend, lambdal, dichte)
rohrlaenge = myShape.Cells("prop.DuctLength").result("mm")
Druckverlust1 = druckverlust(Rohrdruckgefällel, rohrlaenge)
result = result + Druckverlust1
End If
End If
Next
MsgBox result
' es gibt nur eine Page, deshalb Nummer=0
myPageNumber = 1
shapeCount = ActiveDocument.Pages(myPageNumber).Shapes.Count
propZetaWert = "Prop.ZetaWert"
' laufe über alle Shapes
For shapeCounter = 1 To shapeCount
' prüfe, ob Shape Benutzerdwefinierte Eigenschaften besitzt
If ActiveDocument.Pages(myPageNumber).Shapes(shapeCounter).SectionExists(visSectionProp, _
True) = True _
Then
Set myShape = ActiveDocument.Pages(myPageNumber).Shapes(shapeCounter)
If myShape.CellExists(propZetaWert, True) = True _
Then
' setze Zeta-Wert in Shape als Text
' myShape.Text = "Zeta-Wert = " & myShape.Cells("Prop.ZetaWert")
' berechne Zeta-Wert für Shape
ZetaWert = myShape.Cells(propZetaWert)
dichte = Dichte_rF(Temperatur1.Value, Luftfeuchte1.Value, Luftdruck.Value)
Rohrinnendurchmesser = myShape.Cells("Height").result("mm")
'Luftgeschwindigkeit = Luftgeschwindigkeit1(Volumenstrom.Value, Rohrinnendurchmesser)
ZetaWert = myShape.Cells(propZetaWert)
Luftgeschwindigkeit1 = Luftgeschwindigkeitl(Volumenstrom.Value, Rohrinnendurchmesser)
druckverlust2 = deltapeinbauten(ZetaWert, Luftgeschwindigkeit1, dichte)
result2 = result2 + druckverlust2
End If
End If
Next
result3 = result2 + result
MsgBox result3
With Ergebnisfenster
.Ergebnisfenstertext = result3
.Show
End With
With Wirtschaftlichkeit1
.Label25 = result3
.Show
End With
End Sub