Exported VBA

wgmaster/vba/MFlaechenbindungen.bas

@@ -0,0 +1,89 @@
+Option Compare Database
+Option Explicit
+
+
+Sub FlaechenbindungenBerechnen(Jahr1 As Long)
+
+Dim db1 As Database
+Dim rs1 As Recordset
+Dim rs2 As Recordset
+Dim temptablename1 As String
+Dim oldMGNR As Long
+Dim countit As Boolean
+Dim summe As Double
+temptablename1 = "xTempFlaechenbindungen"
+
+Set db1 = CurrentDb
+
+Set db1 = CurrentDb
+If TableExists(temptablename1) Then
+ db1.Execute ("DROP TABLE " + temptablename1)
+End If
+db1.Execute ("CREATE TABLE " + temptablename1 + " (MGNR LONG, Gesamtflaeche DOUBLE);")
+Set rs1 = db1.OpenRecordset("SELECT * FROM TFlaechenbindungen ORDER BY MGNR")
+Set rs2 = db1.OpenRecordset(temptablename1)
+oldMGNR = -1
+While Not rs1.EOF
+ If oldMGNR <> rs1("MGNR") Then
+  If oldMGNR <> -1 Then
+   rs2("MGNR") = oldMGNR
+   rs2("Gesamtflaeche") = summe
+   rs2.Update
+  End If
+  rs2.AddNew
+  summe = 0
+ End If
+ 
+ countit = True
+ If IsNull(rs1("Von")) Then
+ Else
+  If rs1("Von") <= Jahr1 Then
+  Else
+   countit = False
+  End If
+ End If
+  
+ If IsNull(rs1("Bis")) Then
+ Else
+  If rs1("Bis") >= Jahr1 Then
+  Else
+   countit = False
+  End If
+ End If
+ 
+ If IsNull(rs1("Flaeche")) Then
+  countit = False
+ End If
+  
+ If countit Then
+  summe = summe + rs1("Flaeche")
+ End If
+ oldMGNR = rs1("MGNR")
+ rs1.MoveNext
+Wend
+rs2.Update
+rs1.Close
+rs2.Close
+
+End Sub
+
+
+
+Function TableExists(table1) As Boolean
+
+Dim db1 As Database
+Set db1 = CurrentDb
+Dim x As TableDef
+
+For Each x In db1.TableDefs
+ If x.Name = table1 Then
+   TableExists = True
+   Exit Function
+ End If
+Next x
+
+   TableExists = False
+
+End Function
+
+