Formularausgabe

[A.DA]

Hallo Zusammen,
ich habe eine Tabelle1 mit einer Raumkonfiguration...

Spalten: ID; Raumnummer; (Belegung) Soll; Not, Max

Die Tabelle im Formular dargestellt, wird jeder Raum in einer Zeile dargestellt.

Wie erreiche ich, dass jeder Raum xmal aufgelistet wird (entsprechend der Sollbelegung)

VG
A.DA

[Christian Marquardt]

In dem du die Tabelle im Formular selbst erzeugst.
Schleife über die Einträge in der Tabelle
Jeden Datensatz dann so oft in das Formular einfügen wie der Sollwert angibt

Ggf. überprüfe dein Datenmodel.
Sofern dies benötigt wird ist dann eine 1:N Beziehung zum Sollwert in einer extra Tabelle einzurichten

[A.DA]

With Me.RecordsetClone
           Do Until .EOF

                     If !Platz > 1 Then
                      For i = 1 To !Platz
                        If i = 1 Then
                        Debug.Print !Raumnummer & "(" & i & ")"
                        Else
                        Debug.Print !Raumnummer & "(" & i & ")"
                        End If
                      Next
                      Else
                      Debug.Print !Raumnummer & "(" & i & ")"
                     End If


                    .MoveNext
                  Loop
   End With

Platz ist der ermittelte Bedarf....

nur wie sage ich dem Form was es machen muss... stehe auf dem Schlauch

[Christian Marquardt]

https://www.google.com/search?client...ische+tabellle

[A.DA]

erstmal vielen Dank, aber irgendwie nicht was ich brauche....

[Christian Marquardt]

Sicherlich ist das was du brauchst.
1. Treffer
https://de.comp.datenbanken.ms-acces...blatt-anzeigen

Was glaubst du zu brauchen?
Worin könnte die Logik liegen, Datensätze zu vermehren?
Du kannst an denen nichts ändern, einfügen o.a.
Access kann die nicht zuordnen; kennt diese nicht. Also musst du was eigenes basteln

[A.DA]

Soo.... es hat eine Weile gedauert, aber nun ist es so wie ich es wünsche.

Vielen Dank

Function Konstrukt1(ByVal abt As String, usf As Object)

Dim db              As ADODB.Connection
Set db = CurrentProject.Connection

Dim SQL As String
Dim suchstr As String
Dim i As Long

SQL = "<<meine Abfrage>>"


    suchstr = "mein Filter"
'
    Dim rs           As New ADODB.Recordset
    Dim rec           As New ADODB.Recordset
    rs.ActiveConnection = db
    rs.CursorLocation = adUseClient
    rs.LockType = adLockOptimistic
    rs.CursorType = adOpenDynamic
    rs.Source = SQL
    rs.Filter = suchstr
    rs.Open

  On Error GoTo Fehler
            With rs
 Set rs.ActiveConnection = Nothing
 'Anzeige Abteilung konstruieren
    If Not rs.EOF Then
 'Platzübersicht gem Konfiguration

       mdl_abteilung.AufbauseiteKonstrukt rs, usf

        End If
  End With
sprung:
    Set rs = Nothing
Exit Function

Fehler:
    Debug.Print Err.Number & " " & Err.Description
GoTo sprung
End Function 

Function AufbauseiteKonstrukt(ByVal rs As Object, usf As Object)
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset

Set conn = CurrentProject.AccessConnection
Set rst = New ADODB.Recordset

Dim Y
For Y = 0 To rs.Fields.Count - 1
  rst.Fields.Append rs.Fields(Y).Name, adVariant
Next
'Zusatzfelder
rst.Fields.Append "Notgem", adBoolean
rst.Fields.Append "Ha_kurz", adVariant
rst.Fields.Append "Familienname", adVariant
rst.Fields.Append "Vorname", adVariant
rst.Fields.Append "Geburtsdatum", adVariant
rst.Fields.Append "Buchnummer", adVariant
rst.Fields.Append "S-verfügung", adBoolean
rst.Fields.Append "Warnungen", adVariant
rst.Fields.Append "Hinweise", adVariant
rst.Fields.Append "Kostform", adVariant
rst.Fields.Append "Arbeit", adVariant
rst.Fields.Append "Bemerkungen", adVariant

rst.CursorLocation = adUseClient
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
rst.Open , , adOpenDynamic

 Dim i, ii As Integer
 Dim Zähler As Integer
 Dim raumNr, Platz As Variant
 Dim abt As String
 Dim Notgem As Boolean
 Do Until rs.EOF
    raumNr = rs!Raumnummer
    abt = rs!ID_Abteilung
    Zähler = 0
  If rs!Platz > 1 Then
        If rs!Platz = 2 Then
           Notgem = True
           Else
           Notgem = False
        End If

    Zähler = rs!Platz - 1


                      For i = 0 To Zähler

                         If i = 0 Then
                          rst.AddNew
                            rst!ID = Nz(rs!ID, "")
                            rst!ID_Abteilung = abt
                            rst!Raumnummer = raumNr
                            rst!Platz = i
                            rst!Notgem = Notgem
                           rst.Update
                        Else

                           rst.AddNew
                            rst!ID = Nz(rs!ID, "")
                            rst!ID_Abteilung = abt
                            rst!Raumnummer = raumNr
                            rst!Platz = i
                            rst!Notgem = Notgem
                           rst.Update

                        End If

                      Next
                Else
                      i = Zähler
                      raumNr = rs!Raumnummer

                      rst.AddNew
                        rst!ID = Nz(rs!ID, "")
                        rst!ID_Abteilung = abt
                        rst!Raumnummer = raumNr
                        rst!Platz = i
                        rst!Notgem = Notgem
                      rst.Update
   End If
   rs.MoveNext
 Loop
rst.MoveFirst
'Set AufbauseiteKonstrukt = rst
 'Set usf.Form.Recordset = rst
 Personendaten_laden rst, usf
End Function 

Sub Personendaten_laden(ByVal rs1 As Object, usf As Object)

Dim db              As ADODB.Connection
Set db = CurrentProject.Connection

Dim sql_PersAbf As String
Dim suchstr As String
Dim i As Long
Dim fld1, fld2
'rst.MoveFirst
Dim rs2           As New ADODB.Recordset
    Dim rec           As New ADODB.Recordset
    rs2.ActiveConnection = db
    rs2.CursorLocation = adUseClient
    rs2.LockType = adLockOptimistic
    rs2.CursorType = adOpenDynamic
    rs2.Source = "qry_zsp_PersAbfr"

    rs2.Open

On Error GoTo Fehler

'Do While Not rs1.EOF
'
'    If Not rs.EOF Then

'
'    End If
'
'  rs1.MoveNext
'Loop
While Not rs1.EOF
   While Not rs2.EOF
     For Each fld1 In rs1.Fields
       For Each fld2 In rs2.Fields
         If rs1!ID = rs2!ID_Raum And rs1!Platz = rs2!Position Then
                rs1!Haftart_kurz = Nz(rs2!Haftart_kurz, "")
                rs1!Familienname = Nz(rs2!Familienname, "")
                rs1!Vorname = Nz(rs2!Vorname, "")
                rs1!Geburtsdatum = Nz(Format(rs2!Geburtsdatum, "dd.mm.yyyy"), "")
                rs1!Buchnummer = Nz(rs2!Buchnummer, "")
                rs1!Kostform = Nz(rs2!Kostform, "")
                rs1!Arbeit = Nz(rs2!Arbeit, "")
                'rs1!Bemerkungen = Nz(rs2!Bemerkungen, "")
                rs1!Sicherheitsverfügung = Nz(rs2!Sicherheitsverfügung, False)
                rs1!Warnungen = Nz(rs2!Warnungen, False)
                rs1!Hinweise = Nz(rs2!Hinweise, False)
                rs1.Update
         End If
       Next fld2
     Next fld1
       rs2.MoveNext
   Wend
   rs2.MoveFirst
   rs1.MoveNext
 Wend


Set usf.Form.Recordset = rs1

sprung:
Set rs1 = Nothing
Set rs2 = Nothing
Exit Sub

Fehler:
    Debug.Print Err.Number & " " & Err.Description
GoTo sprung
End Sub

[Christian Marquardt]

Neues Thema, neuer Thread
https://entwickler-forum.de/forum/da...port-erstellen