Translate

Montag, 27. Mai 2013

ACCESS: Datensätze verbinden und in einem Gesamtstring zusammensetzen

Eine Relationale Datenbanken bietet die Möglichkeit zu einem Hauptdatensatz, n viele Unterdatensätze zu zuordnen.
Z.B. werden hier mehrere Gruppen zu einem Kontakt zugeordnet:


ID
Suchname
Zugeordnete Gruppen
1
Jean Pierre Allain
Feunde
1
Jean Pierre Allain
Geschäftlich
1
Jean Pierre Allain
Familie
2
Peter Maier
Feunde
2
Peter Maier
Geschäftlich


Leider hat die Jet-SQL keine eigene Concat-Anweisung, um die Datensätze eines Hauptdatenstzes in einem Feld auszugeben, so wie in dieser Form:


ID
Suchname
Zugeordnete Gruppen
1
Jean Pierre Allain
Familie; Feunde; Geschäftlich
2
Peter Maier
Feunde; Geschäftlich
 
Abhilfe schafft hier eine kleine flexible VBA-Funktion.
Mit der JoinRecords-Funktion wird der Feldinhalt aus mehreren Datensätzen zu einem Gesamtstring zusammengesetzt.
Public Function JoinRecords(Fieldname As String, _
  TableQueryName As String, _
  Optional Criteria As String, _
  Optional SeparatorChars As String = "; ", _
  Optional MaxRows As Long = 0, _
  Optional MaxChars As Long = 0, _
  Optional NoNullFields As Boolean = True, _
  Optional FinalChars As String = "...", _
  Optional ErrSilent As Boolean = True, _
  Optional ByRef ErrDescription As String, _
  Optional ByRef ErrNumber As Long) As String
 
  ' Fieldname = Feldname aus der Tabelle/Abfrage der verwendet werden soll.
  ' TableQueryName = Tabelle- oder Abfragename die die 1:n Datensätze liefert.
  ' Criteria = Kriterien um den Datenbereich einzuschränken
  '   (Angabe wie bei der WHERE-Klausel).
  ' SeparatorChars = Gewünschte Trennzeichen zwischen den verketteten Texten.
  ' MaxRows = Maximale Anzahl Zeilen die aus TableQueryName gelesen werden sollen.
  '   Bei 0 keine Begrenzungen.
  ' MaxChars = Maximale Anzahl Zeichen die die Funktion zurückgeben soll. Bei 
  ' Überschreitung, wird die Begrenzung eingehalten und der Text aus der Variable 
  '   "FinalChars" wird am Ende verkettet. Bei 0 keine Begrenzungen.
  ' NoNullFields = Überspringt die Zeile, wenn der Wert im Feld Fieldname Null ist.
  ' FinalChars = Gewünschter Text der erscheint, wenn die MaxChars-Zahl überschritt ist.
  ' ErrSilent = Keine Fehlermeldung ausgeben
  ' ErrDescription = Enthält bei Fehler die Fehlerbeschreibung
  ' ErrNumber = Enthält bei Fehler die Fehlernummer
 
  Static db As Object ' DAO.Database
  Dim rs As Object    ' DAO.Recordset
  Dim t As String
  Dim f() As String
  Dim i As Long
 
  On Error GoTo Treat_Err
 
  If db is Nothing Then Set db = Currentdb()  ' Access; VB = DB-Objekt!!!
  t = " WHERE "
  If Len(Criteria) > 0 Then
    Criteria = t & "(" & Criteria & ")"
    t = " AND "
  End If
  If NoNullFields Then Criteria = Criteria & t & "[" & Fieldname & "] Is Not Null"
  Set rs = db.OpenRecordset("SELECT [" & Fieldname & "] FROM [" & TableQueryName & "]" & Criteria, 4)
  If Not rs.EOF Then
    rs.MoveLast
    rs.MoveFirst
    If MaxRows > 0 And rs.RecordCount > MaxRows Then 
      MaxRows = MaxRows - 1  
    Else 
      MaxRows = rs.RecordCount - 1
    endif
    ReDim f(MaxRows)
    For i = 0 To MaxRows
      f(i) = rs(0) & ""
      rs.MoveNext
    Next 
    t = Join(f, SeparatorChars)
    If MaxChars > 0 Then 
      If Len(t) > MaxChars Then t = left(t, MaxChars - Len(FinalChars)) & FinalChars
    End If
    JoinRecords = t
  End If
 
Exit_Proc:
  On Error Resume Next
  rs.Close
  Set rs = Nothing
  Exit Function
 
Treat_Err:
  ErrDescription = Err.Description
  ErrNumber = Err.Number
  If ErrSilent Then
    JoinRecords = "Error " & Err.Number & " " & Err.Description
  Else
    Beep
    MsgBox Err.Description, vbCritical, "Error " & Err.Number
  End If
  Resume Exit_Proc
End Function

 Anwendungsbeispiel:

SELECT tblKontakt.ID, tblKontakt.Suchname, joinrecords("Bezeichnung","qryGruppen","KontaktID=" & [ID]) AS [Zugeordnete Gruppen]
FROM tblKontakt

SQL-Code vom Abfrage-Objekt "qryGruppen":
SELECT G.Bezeichnung, Z.KontaktID
FROM tblGruppe AS G INNER JOIN tblZuordnungKontaktGruppe AS Z ON G.ID = Z.GruppeID
GROUP BY G.Bezeichnung, Z.KontaktID
ORDER BY Z.KontaktID, G.Bezeichnung;
 

Dienstag, 7. Mai 2013

EXCEL Pivot Tabelle: Alle gruppierte Elemente anzeigen, auch die ohne Daten

Die Elemente aus der Zeilen- und Spaltenbeschrfitung einer Pivot-Tabelle ergeben sich aus den gefundenen Elementen in der Datenherkunft.
Wird der berichtsfilter verwendet, kann es vorkommen, dass nicht zu allen Elementen Daten gefunden werden, und somit erscheinen diese Elemente nicht in der Pivot-Tabelle.

Nehmen wir mal eine Auswertung Summe von Menge pro Monat im Jahre 1999.
Da im Jahre 1999 in den Monaten 1 bis 4 kein Umsatz getätigt wurde, stellen wir fest diese Monate in der Pivot-Tabelle nicht abgebildet werden:


















Diese fehlenden Monate können wie folgt dennoch angezeigt werden:
  1. Klicken Sie mit der rechten Maustaste auf einer der Elemente
  2. Wählen Sie den Befehl Feldeigenschaften aus
  3. Setzen Sie einen Hacken bei Elemente ohne Daten anzeigen












Himweis!
Ab Excel 2007 versteckt sich der Befehl Elemente ohne Daten anzeigen unter dem Register Layout & Drucken

Donnerstag, 2. Mai 2013

Access 2010 nimmt extrem viel CPU-Zeit in Anspruch bei langer Laufzeit

Wenn eine Access-Anwendung rund um die Uhr ununterbrochen im Einsatz ist, nimmt Access 2010 plötzlich extrem viel CPU-Zeit in Anspruch.

Mittlerweile wurde die Liste der Probleme bei langen Laufzeiten von Access noch einmal erweitert: nach Informationen von Microsoft müssen Sie auch damit rechnen, dass Domänenfunktionen keine oder falsche Ergebnisse anzeigen, wenn Sie Access nicht regelmäßig beenden und neu starten.

Das folgende kostenlose Update soll diese Probleme zwar beheben, aber dennoch empfiehlt es sich, auf die Laufzeit Ihrer Datenbanken zu achten:

Hier kostenlosen Hotfix für Access 2010 anfordern

MS Access: Autowert zurücksetzen



Aufgabenstellung:
Das Autowert-Feld einer Tabelle soll wieder auf 1 oder den nächsthöheren freien Wert zurückgesetzt werden, nachdem Datensätze eingegeben und wieder gelöscht wurden.

Dafür gibt es 3 Lösungen die jede für sich Vor- und Nachteile hat.

Lösung 1:
Komprimierung der Datenbank-Datei. Dies sollte die Autowerte aller Tabellen auf den nächsthöheren freien Wert zurück setzen.
Nachteil: Ab Version Access 2000 funktioniert das oft nicht mehr.

Lösung 2: 
Erstellen Sie eine Abfrage und kopieren Sie den folgenden SQL-Statment in die sql-Ansicht rein und ersetzen Sie die Platzhalter Tabellenname und AutowertFeldname mit den entsprechenden:
ALTER TABLE [Tabellenname] ALTER COLUMN [AutowertFeldname] COUNTER(1,1)
Nachteil: Die Aktionsabfrage schlägt fehl, wenn bestehenden Beziehungen auf das Feld AutowertFeldname vorhanden sind. Somit muss zunächst diese Beziehungen entfernt werden und anschließend können diese wieder gesetzt werden.

Lösung 3:

Public Function SetSeed(strTbl As String, Optional lngID As Long) As Boolean
    'Purpose: Reset / Set the Seed of the AutoNumber-Field from a table
    'Condition: Reference on Microsoft ADO Ext. 2.8 for DLL (msADOX.dll)

    Dim cat As New ADOX.Catalog, col As ADOX.Column
   
    Set cat.ActiveConnection = CurrentProject.Connection
    Set col = GetTheAutoNumberColumn(cat.Tables(strTbl))
    If col Is Nothing Then
        MsgBox "In der Tabelle '" & strTbl & "' wurde kein Autowert-Feld gefunden!", vbCritical
    Else
        If lngID = 0 Then lngID = Nz(DMax(col.Name, strTbl), 0) + 1
        If Not col.Properties("Seed") = lngID Then col.Properties("Seed") = lngID
        SetSeed = True
    End If
    Set cat = Nothing
    Set col = Nothing
End Function

Public Function GetTheAutoNumberColumn(tbl As ADOX.Table) As Object
    'Purpose: Find the AutoNumber-Field from a table and if found then return the Column-Object
    Dim col As Object
   
    For Each col In tbl.Columns
        If col.Properties("Autoincrement") Then
            Set GetTheAutoNumberColumn = col
            Exit For
        End If
    Next
End Function

Nachteil: Keiner, außer das dieser VBA-Code hinterlegt werden muss und ein Verweis auf die ADO bestehen muss.

Zu diesem Thema gibt es noch den folgenden interessanten Link! 

Mittwoch, 24. April 2013

MS ACCESS: Alle Spalten einer Kreuztabellenabfrage summieren

Die Kreuztabellenabfrage hat die Aufgabe Daten nach Zeilen und Spalten zu gruppieren.

In der folgenden Abbildung werden Auftragsdaten nach Jahrgang zeilenweise gruppiert und nach Monat spaltenweise und der Umsatz summiert:

Der SQL-Code dazu sieht wie folgt aus:
TRANSFORM Sum([Einzelpreis]*[menge]) AS Umsatz
SELECT Year([ErstelltAm]) AS Jahrgang
FROM tblAuftragsdaten
GROUP BY Year([ErstelltAm])
PIVOT Month([ErstelltAm]);


An dieser Stelle besteht häufig der Wunsch die Monatsspalten 1 bis 12 zu summieren, um die Jahressumme zuzätzlich abzubilden.
Dies ist durchaus möglich und könnte so aussehen:
Erreicht wird dies ganz einfach mit folgender kleinen Erweiterung im SQL-Code:
TRANSFORM Sum([Einzelpreis]*[menge]) AS Umsatz
SELECT Year([ErstelltAm]) AS Jahrgang, Sum([Einzelpreis]*[menge]) AS Jahresumsatz
FROM tblAuftragsdaten
GROUP BY Year([ErstelltAm])
PIVOT Month([ErstelltAm]);


In der Entwursansicht wird dies folgendermaßen hinterlegt:

Eine Endsummenzeile läßt sich über eine Abfrage (SQL-Code) nicht erzeugen.
Ab der Version 2007 ist  Access zwar in der Lage eine solche Endberechnungszeile darzustellen, doch diese wird nicht aus dem SQL-Code erzeugt, sondern die Datenblattansicht von Access berechnet und stellt diese Endzeile dar.

Dienstag, 23. April 2013

MS EXCEL: Inhalt eines ADO- oder DAO-Recordset-Objekts in ein Arbeitsblatt kopieren

Mit der Methode CopyFromRecordset läßt sich sehr einfach und schnell den kompletten Inhalt eines ADO- oder DAO-Recordset-Objekts in einem Tabellenblatt ausgeben.

Hier ein Beispiel mit dem Objekt DAO (Verweis auf Microsoft DAO 3.6 erforderlich)
Public Sub HoleDaten()
    Dim db As DAO.Database, rs As DAO.Recordset
    Dim rgTarget As Range, anz As Long, iCols As Integer
   
    Set db = Dao.OpenDatabase("MeineDatenbankDatei.mdb")
    Set rs = db.OpenRecordset("MeineTabelle")
    Set rgTarget = Tabelle1.Range("A1")
    For iCols = 0 To rs.Fields.Count - 1
        rgTarget.Parent.Cells(rgTarget.Row, rgTarget.Column + iCols).Value = rs.Fields(iCols).Name
    Next
    Set rgTarget = rgTarget.Offset(1)
    anz = rgTarget.CopyFromRecordset(rs)
    MsgBox "Anzahl eingefügte Datensätze: " & anz
End Sub


Laut Tip aus meinem Post datenbankzugriff-per-vba-via-dao hier eine fertige Funktion mit Variante ohne erforderlichen Verweis auf Microsoft DAO 3.6: 
Public Function CopyFromRecordsetEX(DatenbankDatei As String, sql As String, Zielbereich As Object, Optional MitÜberschriften As Boolean = True _
                            , Optional MaxZeilen As Long, Optional MaxSpalten As Long _
                            , Optional ByRef AnzahlDatensätze As Long) As Boolean
    Dim oDAO As Object, db As Object, rs As Object, fld As Object
    Dim Klassenname As String
   
    On Error GoTo Err_Handle
    Klassenname = "DAO.DBEngine.36"
    If Application.Version > "11.0" Then Klassenname = "DAO.DBEngine.120"
    Set oDAO = CreateObject(Klassenname)
   
    Set db = oDAO.OpenDatabase(DatenbankDatei)
    Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
   
    If Zielbereich Is Nothing Then Set Zielbereich = ActiveCell
    Set Zielbereich = Zielbereich(1)
    MaxZeilen = Zielbereich.Parent.Rows.Count - Zielbereich.Row
    MaxSpalten = Zielbereich.Parent.Columns.Count - Zielbereich.Column
    If MitÜberschriften Then
        For Each fld In rs.Fields
            Zielbereich = fld.Name
            Set Zielbereich = Zielbereich.Offset(, 1)
        Next
        Set Zielbereich = Zielbereich.Offset(1, -rs.Fields.Count)
    End If
    AnzahlDatensätze = Zielbereich.CopyFromRecordset(rs, MaxZeilen, MaxSpalten)
    CopyFromRecordsetEX = True

Exit_Proc:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    Set oDAO = Nothing
    Exit Function
   
Err_Handle:
    Beep
    MsgBox Err.description, vbCritical, "Error number: " & Err.Number
    Resume Exit_Proc
End Function

Montag, 22. April 2013

MS ACCESS: Verwenden von OK/Abbrechen/Übernehmen Schaltflächen in Formularen

Aufgabenstellung:
Der Wunsch ist die drei klassischen Befehlsschaltflächen OK / Abbrechen / Übernehmen in einem Access-Formular abzubilden mit entsprechenden Funktionalitäten:



OK - Befehlsschaltfläche:
Datensatz speichern (wenn nötig) und Fenster schliessen (wenn erfolgreich gespeichert)

Abbrechen - Befehlsschaltfläche:
Formular schliessen ohne aktuelle Änderungen im Datensatz zu speichern

Übernehmen - Befehlsschaltfläche:
Datensatz speichern und die Übernehmen - Befehlsschaltfläche deaktivieren
 
Mit dem Einsatz der richtigen Formular-Ereignisprozeduren, lassen sich die Anforderungen gut lösen. 
Die Prozeduren die sich im Formular frmProdukt in der datei 'SchaltflächenOkAbbrechenÜbernehmen.mdb' befinden, können in jedes Formular übertragen und genutzt werden. Anpassungen sind nur dann notwendig, wenn bereits die gleichen Ereignisprozeduren verwendet worden sind. Dann müssen die Befehle aus der Ereignissprozeduren in die bestehenden von Ihrem Projekt reinkopiert werden.


Die Beispiel-Datei kann unter folgenden Link heruntergeladen werden:
SchaltflächenOkAbbrechenÜbernehmen.zip 

Voraussetzung:
MS Access 2010, 2007, 2003, 2002 oder 2000