AW: pdf Erstellen
10.07.2011 19:50:04
fcs
Hallo Schwed25,
ich kenne jetzt keine Variante um direkt zu Erkennen, dass die Datenabfrage abgeschlossen ist.
Du kannst aber mit OnTime die Sekundärauswertung und das Erstellen der PDF-Datei zeitverzögert starten.
Dazu muss du die Aktionen auf mehrere Prozeduren verteilen.
Nachfolgend ein Beispiel-Code, der in einem allgemeinen Modul der Datei gespeichert werden muss.
Gruß
Franz
'Erstellt unter Windows Vista, Excel 2007
Option Explicit
Public Zaehler, ZaehlerMax, iCount As Integer, icountMax As Integer
Public wksPivot As Worksheet, wksDaten As Worksheet
Public vSuchwert, dOnTime As Date
Sub StartImport()
'Startwerte für die Verarbeitung setzen
'Tabellenblatt mit Pivottabelle
Set wksPivot = ThisWorkbook.Worksheets("TabelleXYZ")
'Tabellenblatt mit den als PDF zu speichernden Daten
Set wksDaten = ThisWorkbook.Worksheets("Auswertung")
'Startwert für Zähler in Pivottabelle setzen/ermitteln
Zaehler = 7 'Zeile mit erstem Wert der aus der Datenbank abgerufen werden soll
'Letzten Wert für Zähler in Pivottabelle setzen/ermitteln
With wksPivot
ZaehlerMax = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
'Zäler für Statusmeldung
iCount = 0
icountMax = ZaehlerMax - Zaehler + 1
Call Datenabfrage
End Sub
Sub StopImport()
'Import abbrechen
On Error Resume Next
Application.StatusBar = False
Application.OnTime earliesttime:=dOnTime, Procedure:="PDF_erstellens", schedule:=False
Set wksDaten = Nothing: Set wksPivot = Nothing
Err.Clear
End Sub
Sub Datenabfrage()
'in Datenbankabfrage zu verwendenden Wert ermitteln/setzen
vSuchwert = wksPivot.Cells(Zaehler, 1)
iCount = iCount + 1
Application.StatusBar = "Abfrage " & iCount & " von " & icountMax & " wird bearbeitet"
'Datenbankabfrage
'Zeitverzögert die Erstellung des PDF-Files starten - hier 15 Sekunden
dOnTime = Now + TimeSerial(Hour:=0, Minute:=0, Second:=15)
Application.OnTime earliesttime:=dOnTime, Procedure:="PDF_erstellen"
End Sub
Sub PDF_erstellen()
Dim sFileName As String
On Error GoTo Fehler
'Sekundärauswertung nach Laden der Abfragedaten
wksDaten.Cells(1, 4) = vSuchwert 'Testzeile
'Name der PDF-Datei festlegen
'Verzeichnis prüfen/erstellen
If Dir(ThisWorkbook.Path & "\PDF", vbDirectory) = "" Then
VBA.FileSystem.MkDir ThisWorkbook.Path & "\PDF"
End If
sFileName = "Auswertung " & vSuchwert & Format(Date, " YYYYMMDD") & ".pdf"
sFileName = ThisWorkbook.Path & "\PDF\" & sFileName
'PDF-Speichern
wksDaten.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'Nächsten Zählerwert setzen
Zaehler = Zaehler + 1
If Zaehler > ZaehlerMax Then
MsgBox "Fertig", vbInformation, "Datenimport + PDF drucken"
Application.StatusBar = False
Call StopImport
Else
'Nächste Abfrage starten
Call Datenabfrage
End If
Fehler:
With Err
Select Case .Number
Case 0 'Ales OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub