PDA

Vollständige Version anzeigen : Fehler beim Schreiben nach Excel


Frechdax
28.03.2006, 12:36
Hi,

wollte mich mal Testweise an das Thema exportieren nach Excel annähern. Da ich das später auf jeden Fall realisieren muss. Habe hier im Forum auch Bsp. gefunden. Habe folgenden Code verwendet.

Private Sub Befehl1_Click()

Dim wbook1 As New Excel.Application
Dim Dummy_Dateiname As String

Dim DB As DAO.Database
Dim RS As DAO.Recordset

Dummy_Dateiname = "H:\TEST.xls"

wbook1.Workbooks.Open (Dummy_Dateiname)

With wbook1
Set DB = CurrentDb
Set RS = DB.OpenRecordset("Abfrage1_Kreuztabelle", dbOpenSnapshot)
For i = 0 To RS.Fields.Count - 1
.Cells(1, i + 1) = RS.Fields(i).Name 'Überschriften einfügen
Next i
.Range("A2").Select 'Feld A2 auswählen
.Selection.CopyFromRecordset RS 'Recordset einfügen
End With

wbook1.Visible = True

End Sub
Wenn ich dann meinen Button drücke, kommt folgende Fehlermeldung:
Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert
Dabei wird die oben blau geschriebene Zeile markiert.

Ich habe von VB auch noch nicht so die Ahnung. Weshalb kommt denn so ein Fehler? Und warum steht im Bsp. DAO.Database und nicht wie in der Hilfe nur Database?

Lg Mareike

Locutus
28.03.2006, 12:49
Hallo
Setze mal unter Extras/Verweise einen Verweis auf die Microsoft DAO 3.6 Library
Gruß
Jörn

Frechdax
28.03.2006, 12:58
Bei mir gibt es den Punkt "Microsoft DAO 3.6 Library" nicht.

Debus
28.03.2006, 13:01
Option Compare Database
Option Explicit

Public Function ExportExcel(objRS As Recordset, ByVal XLName As String, _
Optional bolFieldNames As Boolean)
On Error GoTo mkrExportExcel_Err
Dim intXLOpen As Integer
Dim objExcel As Object
Dim objExcelSheet As Excel.Worksheet
Dim intExcelCalcMode As Integer
Dim strErgString As String
Dim strZusFass As String
Dim strSuchFeld As String
Dim AnzVar As Integer
Dim SumVar As Currency
Dim z As Integer
Dim i As Integer

Set objExcel = New Excel.Application
' Sichtbar machen und Tastatur, sowie Mauseingaben
' blockieren
objExcel.Visible = True
objExcel.Interactive = False
' Tabellenblatt 1 mit den Auswertungsparametern erzeugen
objExcel.Workbooks.Add
' Aktives Blatt setzen
' Erstes Blatt benennen
Set objExcelSheet = objExcel.ActiveWorkbook.Sheets(1)
objExcel.ActiveWorkbook.Sheets(1).Name = "Ergebnis"
' Den alten Berechnungsmodus speichern
' und temporär auf manuell setzen
intExcelCalcMode = objExcel.Calculation
objExcel.Calculation = xlCalculationManual
' die Anzeigeaktualisierung unterdrücken
objExcel.ScreenUpdating = False
' Eindeutige Kennzeichnung der Excel-Tabelle durch Kopf- und Fusszeilen
' Linker Fußzeilenbereich
strErgString = "Ausw.Lauf OMS (Ende): " & _
Format(DLookup("AuswVom", "tabAuswertungen", _
"AuswVom = " & convDat & _
" AND AuswUm = " & convUhr), "dd.mm.yyyy") & _
" - " & _
Format(DLookup("AuswUm", "tabAuswertungen", _
"AuswVom = " & convDat & _
" AND AuswUm = " & convUhr), "Short Time") & _
" Uhr" & Chr(13) & "Ausw.Zeitraum: " & _
DLookup("AuswVomBis", "tabAuswertungen", _
"AuswVom = " & convDat & _
" AND AuswUm = " & convUhr) & Chr(13)
' Ausgewählte Parameter aus Auswertungsformular
Select Case intAuswNr
Case 0:
strErgString = strErgString & "PLZ-Bereiche/Leistungsarten: "
strErgString = strErgString & "Alle/Alle"
Case 1:
strErgString = strErgString & "Ausgew. PLZ-Bereich: "
strErgString = strErgString & strPLZBer & _
" (" & DLookup("PLZBerName", "tabPLZBereiche", _
"PLZBerNr = " & strPLZBer) & ")"
Case 2:
strErgString = strErgString & "Ausgewählte Leistungsart: "
strErgString = strErgString & _
strLeiArt & " (" & _
DLookup("[Leistungsart, Klartext]", _
"tabLeistungsArten", _
"Leistungsart = '" & strLeiArt & _
"' And [Leistungsart (wahlfrei)] = '000'") & ")"
Case 10:
strErgString = strErgString & _
"Ausgew. PLZ-Bereich/Zuordnung Leistungsart: "
strErgString = strErgString & "Alle/" & strZuordnung
Case 11:
strErgString = strErgString & _
"Ausgew. PLZ-Bereich/Zuordung Leistungsart: "
strErgString = strErgString & strPLZBer & "=" & _
DLookup("PLZBerName", "tabPLZBereiche", _
"PLZBerNr = " & strPLZBer) & "/" & strZuordnung
End Select
' Seitenformat festlegen
objExcelSheet.PageSetup.Orientation = xlLandscape
' Beschreiben
objExcelSheet.PageSetup.LeftFooter = strErgString
' Rechter Fusszellenbereich
objExcelSheet.PageSetup.RightFooter = "Seite &P von &N"
' Linker Kopfzeilenbereich
objExcelSheet.PageSetup.LeftHeader = "&B<Firma>&B" & Chr(13) & _
"Controlling PKS"
' Mittlerer Kopfzeilenbereich
objExcelSheet.PageSetup.CenterHeader = "&B<Anwendungsname>&B" & _
Chr(13) & "Auswertungsergebnis"
' Rechter Kopfzeilenbereich
' Benutzer- und Computernamen auslesen
ElectUserComputer
objExcelSheet.PageSetup.RightHeader = UserName & Chr(13) & _
"Ausgabe am " & _
Format(Date, "dd.mm.yyyy") & _
Chr(13) & _
"Auswertung Nr. " & intAuswNr
objExcelSheet.DisplayPageBreaks = False
objExcelSheet.PrintPreview
' Sind Feldnamen gewünscht, diese in die erste Zeile schreiben
If bolFieldNames = True Then
For i = 0 To objRS.Fields.Count - 1
objExcelSheet.Cells(1, i + 1).Value = objRS.Fields(i).Name
Next
' und fett formatieren
objExcelSheet.Range(objExcelSheet.Cells(1, 1), _
objExcelSheet.Cells(1, i)).Font.Bold = True
' die Anzeigeaktualisierung unterdrücken
objExcel.ScreenUpdating = False
' Das Recordset einlesen
objExcelSheet.Range("A2").CopyFromRecordset objRS
Else
' die Anzeigeaktualisierung unterdrücken
objExcel.ScreenUpdating = False
' Das Recordset einlesen
objExcelSheet.Range("A1").CopyFromRecordset objRS
End If
' Formatieren der Zellen und Berechnungen
With objExcel
.Range("B:B").NumberFormat = "#,###"
.Range("C:D").NumberFormat = "#,##0.00 €"
.Range("E:E").NumberFormat = "#,###"
.Range("F:H").NumberFormat = "#,##0.00 €"
.Range("I:J").NumberFormat = "##0.000%"
.Range("K:L").NumberFormat = "[=0]""Nein"";[=1]""Ja"";Standard"
.Range("K1") = "K_ü_Ø"
.Range("L1") = "A_ü_V"
' Tabellenname für Werte und Summenzeile festlegen
If intAuswNr = 10 Or intAuswNr = 0 Or intAuswNr = 2 Then
strZusFass = "tabZusFassungEndg"
strSuchFeld = "[PLZ-Bereich]"
z = 12
ElseIf intAuswNr = 1 Or intAuswNr = 11 Then
strZusFass = "tabZusFassungEndg1"
strSuchFeld = "[LeiArt]"
' Datensätze zählen
z = DCount("[LeiArt]", "tabZusFassungEndg1") + 2
Else
Exit Function
End If
' vorhandene PLZ-Bereiche/L-Arten
AnzVar = DCount(strSuchFeld, strZusFass)
.Range("A" & z) = AnzVar
' Summe Fallzahl
SumVar = DSum("[Fallzahl AWZ]", strZusFass)
.Range("B" & z) = SumVar
' Summe Betrag AuswZR
SumVar = DSum("[Gesamtbetrag AWZ]", strZusFass)
.Range("C" & z) = SumVar
' Berechnung Kosten je Fall insgesamt
' Null bei Fallzahl abfangen
If DSum("[Fallzahl AWZ]", strZusFass) = 0 Then
SumVar = 0
Else
SumVar = DSum("[Gesamtbetrag AWZ]", strZusFass) / _
DSum("[Fallzahl AWZ]", strZusFass)
End If
' wie oben nur für Vorjahr
.Range("D" & z) = SumVar
SumVar = DSum("[Fallzahl Vorjahr]", strZusFass) ' Fallzahl
.Range("E" & z) = SumVar
SumVar = DSum("[Gesamtbetrag Vorjahr]", strZusFass) ' Betragssumme
.Range("F" & z) = SumVar
If DSum("[Fallzahl Vorjahr]", strZusFass) = 0 Then
SumVar = 0
Else
SumVar = DSum("[Gesamtbetrag Vorjahr]", strZusFass) / _
DSum("[Fallzahl Vorjahr]", strZusFass) ' Kosten je Fall
End If
.Range("G" & z) = SumVar
' Veränderung AWZ ggüber Vorjahr
If DSum("[Fallzahl AWZ]", strZusFass) + _
DSum("[Fallzahl Vorjahr]", strZusFass) = 0 Then
SumVar = 0
Else
If DSum("[Fallzahl AWZ]", strZusFass) = 0 And _
DSum("[Fallzahl Vorjahr]", strZusFass) > 0 Then
SumVar = 0 - DSum("[Fallzahl Vorjahr]", strZusFass)
ElseIf DSum("[Fallzahl Vorjahr]", strZusFass) = 0 And _
DSum("[Fallzahl AWZ]", strZusFass) > 0 Then
SumVar = DSum("[Gesamtbetrag AWZ]", strZusFass) / _
DSum("[Fallzahl AWZ]", strZusFass)
Else
SumVar = (DSum("[Gesamtbetrag AWZ]", strZusFass) / _
DSum("[Fallzahl AWZ]", strZusFass)) - _
(DSum("[Gesamtbetrag Vorjahr]", strZusFass) / _
DSum("[Fallzahl Vorjahr]", strZusFass))
End If
End If
.Range("H" & z) = SumVar
' Summe Ausgabenanteil (=100%) für Kontrollzwecke
AnzVar = DSum("[Ausgabenanteil]", strZusFass)
.Range("I" & z) = AnzVar
.Range("I" & z).NumberFormat = "000%"
' Summe Versichertenanteil (=100%, nur für ZusFassung nach PLZ-Berei.)
' f. Kontrollzwecke
If Len(strZusFass) = 17 Then
AnzVar = DSum("[Versichertenanteil]", strZusFass)
.Range("J" & z) = AnzVar
.Range("J" & z).NumberFormat = "000%"
End If
' Die letzte Datenzeile wird unterstrichen ...
With objExcelSheet.Range("A" & z - 1 & ":L" & z - 1)
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
End With
' ... und fett gedruckt
.Range("A" & z & ":L" & z).Font.Bold = True
' Seitenformatierungen (Gitternetzlinien, alles auf 1 Blatt
' linker und rechter Seitenrand [sonst passt's nicht])
objExcelSheet.PageSetup.PrintGridlines = True
objExcelSheet.PageSetup.Zoom = 75
objExcelSheet.PageSetup.LeftMargin = objExcel.CentimetersToPoints(1.5)
objExcelSheet.PageSetup.RightMargin = objExcel.CentimetersToPoints(1)
' Gehört zu nächstem Befehl!
.Range("A2").Select
End With
' Überschrift fixieren
objExcel.ActiveWindow.FreezePanes = True
' Spaltenbreite optimal einstellen
objExcel.Range("A:K").Columns.AutoFit
' Schluss-Stellung
objExcel.Range("A2").Select
' die Anzeigeaktualisierung einschalten
objExcel.ScreenUpdating = True
' Den alten Berechnungsmodus reaktivieren
objExcel.Calculation = intExcelCalcMode
' Tastatur- und Mauseingaben wieder zulassen
objExcel.Interactive = True
' Objektreferenzen zerstören
Set objExcelSheet = Nothing
Set objExcel = Nothing

mkrExportExcel_Exit:
Exit Function
mkrExportExcel_Err:
MsgBox Error$
Resume mkrExportExcel_Exit
End Function



Es ist glaube ich alles drin, von der Zellenansteuerung über Kopf- und Fußzeile bis hin zur Formatierung. Also nicht wegen der vielen Codezeilen aufgeben. Ein bißchen was musst Du natürlich anpassen.

Die Grundlagen für diese Funktion habe ich übrigens aus dem Buch "DAS ACCESS-VBA Codebook" Addison-Wesley, ISBN 3-8273-1953-6, das ich sehr empfehlen kann.

Debus
28.03.2006, 13:02
Nochwas zur DAO wenn Du die 3.6 nicht hast, dann vielleicht eine 3.5

Frechdax
28.03.2006, 13:04
Ich habe irgendwie gar nichts mit DAO. Ich probiere mal den Code.

Debus
28.03.2006, 13:08
Aber nicht vergessen, Du musst den Code schon auf Deine Bedürfnisse hin anpassen.

Aber die DAO brauchst Du so oder so.

Mach mal ein Modul auf, und schauen unter Verweise.

Das Dingen heißt genau

Microsoft DAO 3.6 Object Library

Frechdax
28.03.2006, 13:25
Hi,

der Code wird mir später auf jeden Fall gut helfen können. Allerdings das mit den DAO ist da so eine Sache. Vielleicht stehe ich ja gerade nur auf dem Schlauch, aber DAO´s gibt es nicht. Hab mal ein Screen-Shot angehängt.

Wie bekomme ich die DAO-Libary? Gibt es einen Standardpfad wo die zu finden ist, dass man evtl. über durchsuchen an die ran kommt?

Oder gibt es andere Möglichkeiten Db´s zu öffnen um an die Reports zu kommen?

Lg Mareike

Debus
28.03.2006, 13:30
Schaumal, ob du folgende Datei auf Deinem Rechner hast (wirst Du haben)

c:\Programme\Gemeinsame Dateien\Microsoft Shared\DAO\dao360.dll ggf dao350.dll

Wenn Du diese Dateien hast, gehen bei den Verweisen auf Durchsuchen und wähle die Datei aus, dann hast auch Du die DAO :=)

Frechdax
28.03.2006, 13:37
Danke! Da war es zu finden. Habe ich gleich unter Verweise eingebunden und jetzt mag der Kompiler auch meine Codezeile.

Lg Mareike

Debus
28.03.2006, 13:39
Gut, dann bis demnächst, und versuche mal meinen Code, der ist ja auch kommentiert, damit kannst du excel dann auch noch "schön" machen