Excel als Report-Generator - Teil 2

Jetzt wird’s interessant

Vielleicht ist Ihnen schon die neue Spalte RangeName ins Auge gesprungen. Bei der bis jetzt vorherrschenden Lösung muss der imaginäre Kunde auf jeden Fall an zwei Stellen Änderungendurchführen, wenn er sein Berichtslayout ändern will: im Excel-Bericht und in der Metadaten-Tabelle USys_FUR_Field, um dem System eventuelle Änderungen der Zielzelle mitzuteilen. Mit einem kleinen Trick lässt sich das für viele Anwendungsfälle umgehen. Dazu nutzt man einfach die Namen, die man in Excel einer Zelle oder einem Bereich zuordnen kann. Man teilt dem Benutzer einfach mit, welche Namen er in seiner Excel-Datei verwenden darf, und die Anwendung exportiert die Daten dann andiese Stelle in der Excel-Datei. Damit wird das Layouten noch benutzerfreundlicher. Den erweiterten Code der Funktion FUR_PrintOut finden Sie im Listing 1.

Public _
Function FUR_PrintOut( _
ByVal DataSource As DAO.Recordset, _
ByVal ProfileKey As String, _
Optional ByVal PrintDirectly As Boolean = False) As Long
On Error GoTo RunError
Dim sql As String
…
(Code aus Listing des ersten Teils der Artikelfolge)
…
'**********************************************************
'* Worksheet-Objekt-Variable definieren
Dim exc_wks As Object
'*******************************************************
'* Daten aus Tabelle in Report übertragen
Dim Sheet As String
Dim Row As Long
Dim col As Long
'* Zähler definieren (Datensatz-Zähler)
Dim Counter As Long
Counter = 0
'* Export des Datums möglich?
Dim flg_Export As Boolean
'* Für jeden Datensatz durchschleifen, ...
DataSource.MoveFirst
While Not DataSource.EOF
'* Für jedes Feld in Metadaten durchschleifen, ...
mta.MoveFirst
While Not mta.EOF
'* Grundsätzlich 'Ja'
flg_Export = True
'* Feld-Name ermitteln
Dim FieldName As String
FieldName = mta!((FieldName))
'* eventuell definierten Namen ermitteln
Dim RName As String
RName = mta!((RangeName)) & ""
'* Zeile und Spalte müssen angegeben sein, ...
If RName <> "" Then
'* Den Zellbezug dieses Namens ermitteln
Dim dmy As String
dmy = exc_wkb.Names.Item(RName).RefersTo
'* Trennzeichen "!" in der Referenz-Angabe
'* ermitteln (entspricht dem Arbeitsblatt)
pos = InStr(1, dmy, "!")
'* Arb.-blatt (bis Trennzeichen) ermitteln
Sheet = Left(dmy, pos - 1)
Sheet = Right(Sheet, Len(Sheet) - 1)
'* Arb.-blatt im Excel-Sheet referenzieren
Set exc_wks = exc_wkb.Worksheets(Sheet)
'* Rangename (ab Trennzeichen) ermitteln
Dim Rng As String
Rng = Right(dmy, Len(dmy) - pos)
'* Zeile und Spalte der Range ermitteln
Row = exc_wks.Range(Rng).Cells(1, 1).Row
col = exc_wks.Range(Rng).Cells(1, 1).Column
flg_Export = True
Else
'* Wurden Angaben für Zelle gemacht?, ...
If (mta!((Row)) & "" = "") Or _
(mta!((Column)) & "" = "") Then
'* Export nicht möglich (zu wenig Angaben)
flg_Export = False
Else
'* Zeile ermitteln
Row = mta!((Row))
'* Spalte ermitteln
col = mta!((Column))
'* Arbeitsblatt ermitteln
Sheet = mta!((Worksheet)) & ""
'* Seite im Excel-Sheet referenzieren
Set exc_wks = exc_wkb.Worksheets(Sheet)
End If
End If
'* Wenn Export möglich ist, ...
If flg_Export = True Then
'* bei mehr als einem Datensatz,
'* relative Positionen von Zeilen
'* und Spalten ermitteln
Select Case mta!((Direction))
Case "oben"
Row = Row - Counter
Case "unten"
Row = Row + Counter
Case "rechts"
col = col - Counter
Case "links"
col = col + Counter
End Select
'* Datum in Zelle einfügen
exc_wks.Cells(Row, col).Value = _
DataSource(FieldName)
End If
'* nächstes Feld
mta.MoveNext
Wend
'* Zähler erhöhen
Counter = Counter + 1
'* nächsten Datensatz
DataSource.MoveNext
Wend
…
((Code aus Listing des ersten Teils der Artikelfolge))
...

Im Listing 2 wird dargestellt, wie man die Funktion FUR_PrintOut verwendet, um den Listendruck durchzuführen.

FUR_ PrintOut zum Ausdruck einer Liste
Public _
Function PrintArtikelliste( _
Optional ByVal PrintDirectly As Boolean = False) _
As Long
On Error GoTo RunError
'* Auswahl-Abfrage generieren
Dim sql As String
sql = ""
sql = sql & "SELECT"
sql = sql & " *"
sql = sql & " FROM"
sql = sql & " [tbl_Artikel]"
Dim dbs As DAO.Database
Set dbs = CurrentDb()
Dim rst As DAO.Recordset
Set rst = dbs.OpenRecordset(sql, dbOpenSnapshot)
'* Bericht drucken, Profil "al" anwenden
Dim rtn As Long
rtn = FUR_PrintOut(rst, "al", PrintDirectly)
rst.Close
dbs.Close
RunError:
Select Case Err.Number
Case 0
Case Else
MsgBox Err.Description, _
vbCritical, _
"Nr. " & Err.Number
End Select
RunTerminate:
Set rst = Nothing
Set dbs = Nothing
End Function