Private Sub Babbrechen_Click()

DoCmd.Close

End Sub

Private Sub BOk_Click()


Dim v1, b1
Dim filter1

If Not IsNull(TVon) Then
 GebundenBerechnen year(TVon), OSortenattributeBeiFlächenbindungOptional, OGebunden
Else
 If Not IsNull(TBis) Then
  GebundenBerechnen year(TBis), OSortenattributeBeiFlächenbindungOptional, OGebunden
 End If
End If

SetParameter "ANLIEFTEXT", TFusstext.Value

If IsNull(TVon1) Then
  v1 = 0
Else
  v1 = TVon1
End If
 
If IsNull(TBis1) Then
  b1 = 999999
Else
  b1 = TBis1
End If


filter1 = "Storniert=False AND "

If IsNull(TZNR) Or TZNR = "" Then
Else
 filter1 = filter1 + "[ZNR]=" + Format(TZNR) + " AND "
End If



If IsNull(TVon) Or TVon = "" Then
Else
 filter1 = filter1 + "Datum>=Datevalue('" + Format(TVon) + "') AND "
End If

If IsNull(TBis) Or TBis = "" Then
Else
 filter1 = filter1 + "Datum<=Datevalue('" + Format(TBis) + "') AND "
End If

Select Case OListe

Case 1:
 filter1 = filter1 + "MGNR>=" + Format(v1) + " AND MGNR<=" + Format(b1)
 'MsgBox (filter1)
 DoCmd.OpenReport "BAnlieferungsbestaetigungMGNR", acPreview, , filter1
Case 2:
 filter1 = filter1 + "PLZ>='" + Format(v1) + "' AND PLZ<='" + Format(b1) + "'"
 'MsgBox (filter1)
 DoCmd.OpenReport "BAnlieferungsbestaetigung", acPreview, , filter1

End Select

DoCmd.Maximize


End Sub

Private Sub BTagWeiter_Click()

TVon = DateValue("01.09." + Format(year(TVon) + 1))
TBis = DateValue("01.11." + Format(year(TBis) + 1))

End Sub

Private Sub BTagZurueck_Click()

TVon = DateValue("01.09." + Format(year(TVon) - 1))
TBis = DateValue("01.11." + Format(year(TBis) - 1))

End Sub



Private Sub Form_Open(Cancel As Integer)

OListe = 1
TVon = DateValue("01.09." + Format(year(Date)))
TBis = DateValue("01.11." + Format(year(Date)))
'TZNR = DFirst("ZNR", "TZweigstellen")
TFusstext = GetParameter("ANLIEFTEXT")
OSortenattributeBeiFlächenbindungOptional = False

End Sub




Private Sub TFusstext_Exit(Cancel As Integer)

If IsNull(TFusstext.Value) Then
 SetParameter "ANLIEFTEXT", " "
Else
 SetParameter "ANLIEFTEXT", TFusstext.Value
End If

End Sub