Kopieren von Daten aus einem Formular mit Unterformular

[mk500]

Halli hallo ich schon wieder

nun habe ich folgendes Problem. Ich habe ein Formular mit einem Unterformular, zwei Buttons und ein Kombinationsfeld und ein Textfeld. (siehe Bild im Anhang)

Die Daten aus dem Unterformular kommen aus einer Abfrage. Das Kombinationsfeld setzt den Filter für die Abfrage. (Auswahl des Mitarbeiters) Das Textfeld zeigt nur die Summe (der Menge) der gefilterten Daten. (eig nicht relevant)

Nun möchte ich mit dem Button "Kopieren" die Daten des Unterformulars markieren Spalte 1, Spalte 2, Spalte 3 und maximal 12 Zeilen um diese dann zu kopieren (wie STRG + C). Dies ist notwendig um die Daten aus Access in ein anderes Programm zu bekommen leider genau in dieser Formatierung. Um sie dort verarbeiten zu können. Danach soll man die Kontrollkästchen "erledigt" dieser kopierten Daten über den Button "Als Erledigt markieren" setzen. Nach einer Aktualisierung wären sie dann aus der Übersicht verschwunden. Und man wäre entweder fertig oder würde die nächsten 12 Zeilen kopieren. Alles am besten über VBA.

Ich hab leider absolut gar keine Idee wie ich das lösen kann, aber vielleicht könnt ihr mir ja helfen.

Viele Grüße
Martin

[Lachtaube]

Theoretisch sollte das so möglich sein.

Code [Auswählen] Erweitern

Private Sub KopierKnopf_Click()
   Dim rs As Object

   With Me.UfoCtlName.Form
      'Zeilen (Datensätze) ermitteln
      Set rs = .Recordset.Clone()
      If rs.RecordCount = 0 Then Exit Sub
      If rs.RecordCount < 12 Then
         .SelHeight = .RecordCount
      Else
         .SelHeight = 12
      End If
      .SelLeft = 1   'links
      .SelTop = 1    'oben
      .SelWidth = 3  'Anzahl Spalten - anpassen
      'Auswahl kopieren
      DoCmd.RunCommand acCmdCopy
   End With
End Sub

Private Sub ErledigtKnopf_Click()
   Dim i As Long, j As Long

   With Me.UfoCtlName.Form
      With .Recordset.Clone()
         If .RecordCount = 0 Then Exit Sub
         If .RecordCount < 12 Then j = .RecordCount Else j = 12
         While i < j
            .Edit
            !Erledigt = True
            .Update
            i = i + 1
         Wend
      End With
      .Requery
   End With
End Sub

[mk500]

Hallo Lachtaube,

danke erst einmal für deine Antwort. Leider bekomme ich eine Fehlermeldung (siehe Bild) bei beiden VBA Click Events. Ich bin mir aber auch nicht sicher, in wie fern ich den Code anpassen muss. Habe versucht das markierte zu ändern, in den Namen von meinem Ufo aber das haut auch nicht hin.

Viele Grüße
Martin

[Xoar]

Huhu,
schau mal bitte nach ob der Rahmen in dem das Unterformular dein ist, genau so heißt wie dein Ufo. Es muss nämlich der Namen des Rahmens angegeben werden und falls der anders heißt als das Ufo gehts auch nicht.

Evt hilft es was.

[Lachtaube]

Statt UfoCtlName muss der Name des Unterformularsteuerelements, der nicht gleichlautend mit dem darin enthaltenen Formular sein muss (aber darf), eingetragen werden.

Ansonsten eine Spieldatenbank im 2003er-Format erstellen und statt bunter Bilder hier hochladen.

[mk500]

hey ho,

danke euch, das mit dem Ufo hat soweit funktioniert. Ich dachte es richtet sich nach dem Ufo Namen. Wusste nicht das Ufo Element in dem jeweiligen Formular ausschlaggebend ist. Das klappt soweit.

So nun folgendes, der Button "als Erledigt markieren" funktioniert soweit. Aber er markiert immer nur einen Eintrag, welcher dann auch verschwindet. Aber nicht die Auswahl die beim "kopiert" button ausgewählt. Der kopiert Button macht aktuell gar nichts. Bringt aber auch keinen Fehler. Zumindest hab ich nach klicken nichts einfügbares in meiner Zwischenablage.

Im Anhang die TestDB in der ich gerade probiere.
Vielleicht noch mal zu den Bedingungen der Button:

--> Kopieren: von den gefilterten Daten max. 12 Zeilen kopieren, wenn nur 7 gefiltert dann halt nur die 7 kopieren

--> als erledigt markieren: die Auswahl von Button "Kopieren" auf Erledigt setzen, wenn 12 Kopiert dann genau die 12 Zeilen, wenn nur 7 markiert dann genau nur diese 7 Zeilen

Vielen Dank im Voraus für Antworten und diese enorme Hilfsbereitschaft.

Grüße
Martin

[Lachtaube]

Da waren doch noch einige Fehler meinerseits vorhanden.

Code [Auswählen] Erweitern

Option Compare Database
Option Explicit

Private Sub Befehl2_Click()
   Dim rs As Object

   Me.ufoTest.SetFocus
   With Me.ufoTest.Form
      'Zeilen (Datensätze) ermitteln
      Set rs = .Recordset.Clone()
      If rs.RecordCount = 0 Then Exit Sub
      If rs.RecordCount < 12 Then
         .SelHeight = rs.RecordCount
      Else
         .SelHeight = 12
      End If
      .SelLeft = 1   'links
      .SelTop = 1    'oben
      .SelWidth = 3  'Anzahl Spalten - anpassen
      'Auswahl kopieren
      DoCmd.RunCommand acCmdCopy
   End With
End Sub

Private Sub Befehl3_Click()
   Dim i As Long, j As Long

   With Me.ufoTest.Form
      With .Recordset.Clone()
         If .RecordCount = 0 Then Exit Sub
         If .RecordCount < 12 Then j = .RecordCount Else j = 12
         While i < j
            .Edit
            !Erledigt = True
            .Update
            .MoveNext
            i = i + 1
         Wend
      End With
      .Requery
   End With
End Sub

Private Sub Kombinationsfeld10_AfterUpdate()
   Me.Requery
End SubUnd dem Kopierknopf musst Du die Ereignisprozedur in den Eigenschaften zuweisen.

PS: von Leer- und Sonderzeichen sollte man in Objektnamen Abstand nehmen. Gleiches gilt für Nachschlagefelder.

[mk500]

danke danke danke >> Lachtaube <<  !!!! 
genau so soll es sein 

Zwei Kleinigkeiten habe ich allerdings noch. Wenn man als Markierungsbereich angenommen 7 Spalten eingibt. Markiert er optisch/farblich 6 Spalten, in die Zwischenablage kopiert er allerdings die geforderten 7 Spalten. Kann man das irgendwie/-wo einstellen?

Und das andere, er kopiert genau die eingestellten 12 Zeilen, aber er kopiert leider auch den "Tabellenkopf" mit, sprich 13 Zeilen. Die Kopfzeile brauche ich natürlich nicht. Bzw. kann ich es im SAP wo die Daten weiter verarbeitet werden nicht einstellen, dass er diese Zeile nicht mit lesen soll.

Viele Grüße
Martin

[Lachtaube]

Zur Optik kann ich leider nichts sagen. Die Spaltenüberschriften sind beim Kopieren immer dabei.

Eine andere Variante wäre, die Daten über ein ADODB-Recordset zusammenzutragen, mit GetString daraus eine Ausgabe zu erzielen und mit Hilfe die Microsoft Forms 2.0 Bibliothek in die Zwischenablage zu bringen.

Alternativ könnte man ebenso die Zwischenablage mit Hilfe der Microsoft Forms 2.0 Bibliothek auslesen, die Kopfzeile daraus entfernen und den verbleibenden Rest erneut in die Zwischenablage einfügen.

[mk500]

okay das ist mit der Optik ist auch nur halb so schlimm.

Bei der anderen Sache:

Alternativ könnte man ebenso die Zwischenablage mit Hilfe der Microsoft Forms 2.0 Bibliothek auslesen, die Kopfzeile daraus entfernen und den verbleibenden Rest erneut in die Zwischenablage einfügen.

Da ich nicht drum herum komme, diese Zeile auf irgendeine Weise zu entfernen, wollte ich fragen ob du mir da ein Beispiel zeigen kannst? Weil das übersteigt meine VBA Kenntnisse bei weitem.

Viele Grüße
Martin

[Lachtaube]

Hier der veränderte Code.

Code [Auswählen] Erweitern

Private Sub Befehl2_Click()
   Const CLSID_DataObject$ = "{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
   
   Dim rs As Object
   Dim s As String

   Me.ufoTest.SetFocus
   With Me.ufoTest.Form
      'Zeilen (Datensätze) ermitteln
      Set rs = .Recordset.Clone()
      If rs.RecordCount = 0 Then Exit Sub
      If rs.RecordCount < 12 Then
         .SelHeight = rs.RecordCount
      Else
         .SelHeight = 12
      End If
      .SelLeft = 1   'links
      .SelTop = 1    'oben
      .SelWidth = 3  'Anzahl Spalten - anpassen
   End With
   
   'Auswahl kopieren
   DoCmd.RunCommand acCmdCopy
   
   With CreateObject("new:" & CLSID_DataObject)
      ' Zwischenablage einlesen
      .GetFromClipboard
      ' Text aus der Zwischenablage zuweisen
      s = .GetText()
      ' Kopfzeile entfernen
      .SetText Mid$(s, InStr(s, vbCrLf) + 2)
      ' ... und in Zwischenablage ablegen
      .PutInClipboard
   End With
End Sub

[mk500]

Perfekt, so sollte es sein. 
Danke für die Hilfe !!!

Viele Grüße
Martin

[mk500]

ich weiß das Thema ist eigentlich schon gelöst. Aber trotzdem habe ich noch ein kleines Problem. Ich habe diesen Code ja einzeln in einer Testdatenbank probiert und alles lief einwandfrei. Nun habe ich alles in die Hauptdatenbank integriert. Das Markieren des ausgewählten Bereiches funktioniert soweit. Das als "Erledigt" markieren auch, nur das kopieren funktioniert nicht.

Ergänzend zur Datenbank: Die Datenbank wird durch selbsterstellte Buttons und Menübänder über Ribbons gesteuert. Das RibbonControl steht in einem extra Modul. Hier der Auszug von dem Teil um den es geht:

Code [Auswählen] Erweitern


' Zeitauswertung
        ' Schließt das Dokument Zeitauswertung
        Case "cbtn431"
        DoCmd.Close acForm, "frmZeitauswertung"
       
        'Datenübergabe SAP (bestimmten Bereich markieren und kopieren)
        Case "cbtn411"
            Const CLSID_DataObject$ = "{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
   
            Dim rs As Object
            Dim s As String

            Forms!frmZeitauswertung!ufrmZeitauswertung.SetFocus
            With Forms!frmZeitauswertung!ufrmZeitauswertung.Form
                'Zeilen (Datensätze) ermitteln
                Set rs = .Recordset.Clone()
                If rs.RecordCount = 0 Then Exit Sub
                If rs.RecordCount < 12 Then
                    .SelHeight = rs.RecordCount
                Else
                    .SelHeight = 12
                End If
                .SelLeft = 1   'links
                .SelTop = 1    'oben
                .SelWidth = 7  'Anzahl Spalten - anpassen
            End With
   
            'Auswahl kopieren
            DoCmd.RunCommand acCmdCopy
   
            With CreateObject("new:" & CLSID_DataObject)
                ' Zwischenablage einlesen
                .GetFromClipboard
                ' Text aus der Zwischenablage zuweisen
                s = .GetText()
                ' Kopfzeile entfernen
                .SetText Mid$(s, InStr(s, vbCrLf) + 2)
                ' ... und in Zwischenablage ablegen
                .PutInClipboard
            End With
           
           
        Case "cbtn412"
            MsgBox "Das ist ein Testbutton!"
           
        'Setzt die Markierten Datensätze auf "Erledigt = True"
        Case "cbtn421"
            Dim i As Long, j As Long

            With Forms!frmZeitauswertung!ufrmZeitauswertung.Form
               With .Recordset.Clone()
                  If .RecordCount = 0 Then Exit Sub
                  If .RecordCount < 12 Then j = .RecordCount Else j = 12
                  While i < j
                     .Edit
                     !Erledigt = True
                     .Update
                     .MoveNext
                     i = i + 1
                  Wend
               End With
               .Requery
            End With
            Forms!frmZeitauswertung!ufrmZeitauswertung.Form.Requery


Beim Kopieren bringt er einen Fehler, dass die Funktion aktuell nicht zur Verfügung steht (siehe Anlage). Hier bleibt der Programmzeiger hängen:

Code [Auswählen] Erweitern


            'Auswahl kopieren
            DoCmd.RunCommand acCmdCopy


Woran könnte das liegen?

Viele Grüße Martin

[Lachtaube]

Ich kann nur raten, dass das Formular nicht altiv ist. Versuche den Abschnitt mit DoCd.SelectObject acForm, "frmZeitauswertung" zu starten.

[mk500]

mal wieder ein großes Dankeschön an Lachtaube. Hat funktioniert. Nun habe ich das Problem das ich zwei Buttons habe die etwas kopieren sollen. Der eine Button wählt 7 Spalten aus, der andere 9 Spalten.

Bei dem mit 7 Spalten funktioniert es ja auch. So bald ich aber den Code kopiere auf 9 ändere und bei dem anderen Button einfüge. Meckert er bzgl. >> Mehrfachdeklaration im aktuellen Gültigkeitsbereich <<

wie löse ich das?