90 lines
1.5 KiB
QBasic
90 lines
1.5 KiB
QBasic
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
|
|
|
|
|