Moin,
ich hab mal wieder was geschraubt, weil es 1.) sowas noch nicht gab oder 2.) ich wieder zu blöd zum Suchen war
(If Option=2 Then DoSanfteErklärung)
Ansonsten Vorschläge, Verbesserungen und Kommentare gern gesehenen.
Spoiler anzeigen
; #FUNCTION# ====================================================================================================================
; Name ..........: _SQLite_Qry2Excel
; Description ...: Eine SQLite-Query aus zuletzt geöffneter Datenbank in Exceltabelle schreiben
; Syntax ........: _SQLite_Qry2Excel($sQry, $sExcelFile[, $fMakeHeadLine = True[, $fAddStatFooter = True[, $fAppend = True[,$fShowProgress=False[,$fWithAutofilter=False]]]]])
; Parameters ....: $sQry - String, der die Abfrage enthält
; $sExcelFile - String, der das Ausgabefile incl. Pfad enthält. Dateiendung muss mit übergeben werden.
; $fMakeHeadLine - [optional] Boolean, True= Kopfzeile in Fettschrift & Trennlinien
; $fAddStatFooter - [optional] Boolean, True= Summenfußzeile (Excel-Summe) in Fettschrift & Trennlinien, erstes Feld aus Abfrage wird nicht "gesummt"
; $fAppend - [optional] Boolean, True= Falls Ausgabedatei vorhanden, wird Sie überschrieben
; False= Feldnamen mit Zeilenüberschriften vergleichen, neue Felder in Excel anlegen
; $fWithAutofilter - [optional] Boolean, True= Automatisch den Excel-Autofilter über den ganzen Datenbereich setzen
; Return values .: None
; Author ........: Karsten Kock
; Remarks .......: Wenn $fAppend=true und mehrere Abfragen mit unterschiedlicher Feldanzahl, passt die Fußzeile u.u. nicht
; In der ersten Spalte sollte immer was stehen, ansonsten wird beim Anhängen und leerer erster Spalte die komplette Zeile überschrieben
; SQLite muss vorher gestartet werden, Daten sollten in Tabellen sein. Es wird die zuletzt geöffnete Tabelle verwendet
; Example .......: _SQLite_Qry2Excel("SELECT LeitRegion, sum(Anzahl) as Anzahl FROM lrstati GROUP BY LeitRegion;","d:\lrstatistik.xls"), True, True, False)
; Erstellt die Datei "d:\lrstatistik.xls" mit der Kopfzeile "LeitRegion" & "Anzahl", den Werten aus der Abfrage
; und der Fußzeile "Summe:" & der Excel-Summenformel
; ===============================================================================================================================
Func _SQLite_Qry2Excel($sQry,$sExcelFile,$fMakeHeadLine=True,$fAddStatFooter=True,$fAppend=True,$fShowProgress=False,$fWithAutofilter=False)
Local $aNames_Colum
Local $aQryResult
Local $hQuery
Local $n
Local $oFoundCol
Local $iFoundCol
Local $iRowCnt
Local $iRowStart
Local $sXlsFormel
Local $iQryCounter
Local $hCSVfile
Local $sCSVrow
Local $oExcel = ObjCreate("Excel.Application")
If Not IsObj($oExcel) Then
MsgBox(4144,"Excel-Fehler","Konnte Excel nicht starten!" & @CRLF & "Ist's überhaupt installiert?" & @CRLF)
Return
EndIf
_SQLite_QuerySingleRow(-1,"SELECT COUNT(*),"&StringMid($sQry,7),$aQryResult) ; Wieviele Zeilen kommen aus der Qry überhaupt raus?
$iQryCounter=$aQryResult[0]
If $fShowProgress Then ; Auch noch nen Progressbalken darstellen
ProgressOn("Gesamt "&$iQryCounter&" Zeilen","Export nach Excel","Exportiere in "&$sExcelFile)
EndIf
; Dann gucken wir mal, ob es die Feldnamen aus der Qry auch als Überschriften gibt
_SQLite_Query(-1,$sQry,$hQuery) ; Erstmal die Query starten
_SQLite_FetchNames($hQuery,$aNames_Colum) ; Und die Spaltennamen einlesen
With $oExcel
.Visible=1-@Compiled
.Application.ScreenUpdating=1-@Compiled
If Not $fAppend Then ; Wenn nicht anhängen, dann ...
FileDelete($sExcelFile) ; ... kann das File gleich gelöscht werden
If $iQryCounter>50 Then ; Ab 100 Datensätzen in der Query ...
; ... schreiben wir lieber mal ne CSV-Datei, weil Excel sonst zu lahmarschig ist
Local $sCSVfilename=StringReplace($sExcelFile,".xls",".csv")
$hCSVfile=FileOpen($sCSVfilename,10)
$sCSVrow=""
For $n=0 To UBound($aNames_Colum)-1
$sCSVrow&=Chr(34)&$aNames_Colum[$n]&Chr(34)&";"
Next
FileWriteLine($hCSVfile,$sCSVrow)
$iRowCnt=0
While _SQLite_FetchData($hQuery,$aQryResult)=$SQLITE_OK
$sCSVrow=""
For $n=0 To UBound($aNames_Colum)-1
$sCSVrow&=Chr(34)&$aQryResult[$n]&Chr(34)&";"
Next
FileWriteLine($hCSVfile,$sCSVrow)
$iRowCnt+=1
If $fShowProgress Then ProgressSet(($iRowCnt*100)/$iQryCounter)
WEnd
_SQLite_QueryFinalize($hQuery)
FileClose($hCSVfile)
.Workbooks.Open($sCSVfilename)
.ActiveWorkBook.SaveAs($sExcelFile,-4143,Default,Default,Default,Default,2,2)
FileDelete($sCSVfilename)
EndIf
EndIf
If Not FileExists($sExcelFile) Then ; File nicht vorhanden => Erstellen
.WorkBooks.Add()
.ActiveWorkbook.Sheets(1).Select()
.Application.DisplayAlerts=False
.Application.ScreenUpdating=False
.ActiveWorkbook.Sheets(3).Delete()
.ActiveWorkbook.Sheets(2).Delete()
.ActiveWorkBook.SaveAs($sExcelFile,-4143,Default,Default,Default,Default,2,2)
Else ; File gibt es => Aufmachen
.WorkBooks.Open($sExcelFile,Default,False)
.ActiveWorkbook.Sheets(1).Select()
EndIf
; Spaltennamen suchen und ersetzen durch die Spaltennummer
For $n=0 To UBound($aNames_Colum)-1
.Rows("1:1").Select
$oFoundCol=.Selection.Find($aNames_Colum[$n],Default,Default,1)
If Not IsObj($oFoundCol) Then ; Diese Spaltennamen gibt es nocht nicht als Überschrift => Dann mal Anhängen
$iFoundCol=.Range("IV1").End(-4159).Column
If $iFoundCol=1 And .Cells($iFoundCol,1).Value="" Then $iFoundCol=0 ; Spalte=1 und leer heißt, dass ja eine neue Excel-Tabelle
$iFoundCol+=1
.Cells(1,$iFoundCol).EntireColumn.Insert
.Cells(1,$iFoundCol).Value=$aNames_Colum[$n]
Else ; Spaltennamen gefunden
$iFoundCol=$oFoundCol.Column
EndIf
$aNames_Colum[$n]=$iFoundCol ; Spaltennummer in $aNames_Colum
Next
$iFoundCol=.Range("IV1").End(-4159).Column ; Die letzte benutze Spalte mal vorsichthalber merken für etvl. AutoFilter
If $fMakeHeadLine Then ; Die Kopfzeile soll schön gemacht werden, dann mach mal
.Cells.Borders.LineStyle=-4142 ; Alle Randlinien aus allen Zellen löschen
.Cells.Font.Bold=False ; Und gleich das ganze Blatt wieder in Normalschrift setzen
.Rows(1).Font.Bold = True ; Aber die Überschrift Fett lassen
.Rows(1).Borders(9).LineStyle=1 ; Überschrift Zelle unten durchgängige Linie
.Rows(1).Borders(9).Weight=1 ; Überschrift Zelle unten dünne Linie
EndIf
$iRowStart=.Range("A65535").End(-4162).Row+1 ; Letzte benutze Zeile+1= nächste freie Zeile ($iRowCnt wird der Zähler)
$iRowCnt=$iRowStart
If .Cells($iRowCnt-1,1).Value="Summe:" Then $iRowCnt-=1 ; Hmm...in der vorletzten Zeile steht "Summe:" vom Footer => Überschreiben
.Rows($iRowCnt).EntireRow.Delete
; Genug gefummelt, nu mal die Daten in die Zeilen schreiben
While _SQLite_FetchData($hQuery,$aQryResult)=$SQLITE_OK
For $n=0 To UBound($aNames_Colum)-1
If StringRegExp($aQryResult[$n],"\A[\d||\.|,]+\z") Then
$aQryResult[$n]=StringReplace($aQryResult[$n],".",",") ; Excel mag keine Punkte in Zahlen => zu Kommas machen
.Cells($iRowCnt,$aNames_Colum[$n]).NumberFormat="Standard"
Else
.Cells($iRowCnt,$aNames_Colum[$n]).NumberFormat="@"
EndIf
.Cells($iRowCnt,$aNames_Colum[$n]).Value=$aQryResult[$n]
Next
$iRowCnt+=1
If $fShowProgress Then ProgressSet((($iRowCnt-$iRowStart)*100)/$iQryCounter)
WEnd
_SQLite_QueryFinalize($hQuery)
; Dann mal alle Spalten schön in die richtige Breite bringen
.Cells.Select
.Selection.ColumnWidth = 70
.Selection.Rows.AutoFit
.Selection.Columns.AutoFit
.Selection.HorizontalAlignment = -4108 ; Unten an Zeile ausrichten
.Selection.VerticalAlignment = -4107 ; Zentriert in Spalte
If $fAddStatFooter Then ; Fußzeile mit den Summen generieren => Dann mach ma, aber das erste Feld aus der Qry ohne Summe
.Cells($iRowCnt,$aNames_Colum[0]).Value="Summe:"
.Cells($iRowCnt,$aNames_Colum[0]).HorizontalAlignment=-4152 ; Das Wort "Summe" rechtsbündig darstellen
For $n=1 To UBound($aNames_Colum)-1 ; Summen nur in den Spalten, wo auch was reingepinselt wurde
.Cells($iRowCnt,$aNames_Colum[$n]).NumberFormat="Standard"
;~ .Cells($iRowCnt,$aNames_Colum[$n]).NumberFormat="0"
If $fWithAutofilter Then ; Auch noch Autofilter gewünscht, dann muss nicht "SUMME" sondern TEILERGEBNIS(109;<BEREICH>" (109 wegen keine Summe von gefilterten)
$sXlsFormel="=TEILERGEBNIS(109;"&.Range(.Cells(2,$aNames_Colum[$n]),.Cells($iRowCnt-1,$aNames_Colum[$n])).Address & ")"
Else ; Kein Autofilter => Normale Summenzeile
$sXlsFormel="=SUMME("&.Range(.Cells(2,$aNames_Colum[$n]),.Cells($iRowCnt-1,$aNames_Colum[$n])).Address & ")"
EndIf
$sXlsFormel=StringReplace($sXlsFormel,"$","")
.Cells($iRowCnt,$aNames_Colum[$n]).Value=$sXlsFormel
Next
.Rows($iRowCnt).Borders(8).LineStyle=1 ; Zelle oben durchgängige Linie
.Rows($iRowCnt).Borders(8).Weight=1 ; Zelle oben dünne Linie
.Rows($iRowCnt).Borders(9).LineStyle=-4119 ; Zelle unten doppelte durchgängige Linie
.Rows($iRowCnt).Borders(9).Weight=4 ; Zelle unten dicke Linie
.Rows($iRowCnt).Font.Bold = True ; Und die ganze Summenzeile in Fettschrift
If $fWithAutofilter Then ; Auch noch Autofilter gewünscht, dann mal den Bereich des Autofilters setzen
.ActiveSheet.AutoFilterMode=False
.Range(.Cells(1,2),.Cells($iRowCnt-1,$iFoundCol)).AutoFilter
EndIf
EndIf
.Cells(1,1).Select
.ActiveWorkbook.Save ; Und den Quark speichern
.Application.Quit ; Und Excel beenden
If $fShowProgress Then ProgressOff ()
EndWith
$oExcel=""
EndFunc
[/autoit]