Anzeige
Archiv - Navigation
1348to1352
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Pivots per VBA aus Access aktualisieren

Pivots per VBA aus Access aktualisieren
06.02.2014 13:02:39
Wos
Hallo zusammen hallo Luschi,
ich habe den Beitrag wohl versehentlich als abgeschlossen markiert.
Ich habe mal was hochgeladen!
Link: https://www.herber.de/bbs/user/89023.zip
Die Access-Datenbank und die drei Excel-Files werden für den Ablauf benötigt.
In Access gibt es den hier gepostete Code im Modul 2. Dieser führt unter anderem das Makro m_Q_kup aus.
Das Makro arbeitet dann mit all den Tabellen und Abfragen sowie dem Formular. Der VBA Code ist nur dafür gedacht, dass das Ganze je Niederlassung erfolgt, wofür ich das Recordset benötige. (ohne die Pivottabellen hat der Code übrigens gut funktioniert).
1. VBA greift sich also die erste Niederlassung trägt sie ins Formular ein und führt das Makro aus. 2. Darauf hin werden die beiden Excel-Tabellen "Datenbasis X" exportiert.
3. Die Daten dieser Tabellen kommen dann in die beiden unterschiedlichen Arbeitsblätter der Excel-Datei "Kundenpyramide".
4. Sodann müssen in zwei weiteren Arbeitsblättern, sowie dem Arbeitblatt "Kundenumsatzsegmente" die Pivottabellen aktualisiert werden.
5. Dann soll die Datei "Kundenpyramide" unter einem eindeutigen Namen (der Niederlassung) abgespeichert werden.
6. Jetzt sollte VBA sich die nächste Niederlassung greifen und bei 1. anfangen, bis alle Niederlassungen durch sind
Im besten Fall bekommt man es noch hin im letzten Schritt alle Niederlassungen aufeinmal in die Datenbasisdateien zu exportieren (Die Datenmenge ist allerdings immens und übersteigt glaube ich den maximalen Zeilenexport um ein Vielfaches) und dann eine "Gesamt Kundenpyramide" zu erstellen. Dafür müsste dann im Formular unter Niederlassung wohl "nichts" eingetragen werden, was ich aber mit dem Recordset bisher nicht realisieren konnte. Vielleicht könnte man ja die Einzeldatenexporte zusätzlich seperat ablegen und dann nach einander in die "Gesamtpyramide" einfügen.
So hoffe die Datenbank reicht aus, damit ihr mir helfen könnt. Musste alles rauslöschen, damit ich das hier überhaupt hochgeladen bekomme. Ich weiß auch nicht ob das Makro ohne die Daten funktioniert.
Freue mich auf eure Rückmeldungen!
Thias

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pivots per VBA aus Access aktualisieren
07.02.2014 08:44:21
fcs
Hallo Thias,
ich hab mir deine Datei mal angesehen.
Leider kann man das Makro in Access nicht ohne Anpassungen starten.
Ich hab mal den Excelteil separat in einer Exceldatei getestet.
Bei den Namen der Pivottabellen scheint im Code etwas nicht zu stimmen.
Hier mal mein Test-Code,alles Accessrelevante hab ich auskommentiert.
Den Code hab ich auch etwas komprimiert. Evtl. kannst du ihn ja in das Accesfile einbauen.
Gruß
Franz
Sub kup_Q()
Dim Stelle As Integer
Dim NL As String
Dim txt As String
Dim pfad As String
Dim admsp As String
Dim myApp As New Excel.Application
Dim anzahl As Integer
'Dim dbs As Database
'Dim rst As Recordset
Dim wb_Vorlage As Excel.Workbook
Dim wb_VPer As Excel.Workbook
Dim wb_aktPer As Excel.Workbook
'recordset aufzeichnen Niederlassungen
'Set dbs = CurrentDb
'pfad = dbs.Name
'Set rst = dbs.OpenRecordset("SELECT betriebsstätten.Niederlassung FROM betriebsstätten GROUP  _
BY betriebsstätten.Niederlassung")
myApp.Visible = True
'pfad = VBA.Left(pfad, VBA.InStrRev(pfad, "\") - 1)
'rst.MoveFirst
myApp.DisplayAlerts = False
'DoCmd.SetWarnings False
'Schleifenbeginn mit Niederlassung aus recordset
'Do While Not rst.EOF
'    Stelle = rst.Fields(0)
'Forms!Formular1!NL = Stelle
'NL = Forms!Formular1!NL
NL = "Test_NL"
'Access Makro ausführen
'DoCmd.RunMacro ("m_Q_kup")
'Excelfiles öffnen
pfad = "K:\Tiefbau2\Kundenpyramiden\Export Q"
'pfad = dbs.Name
pfad = VBA.Left(pfad, VBA.InStrRev(pfad, "\") - 1)
pfad = ThisWorkbook.Path 'Excel Testzeile
Set wb_Vorlage = myApp.Workbooks.Open(Filename:=pfad & "\ _
Kundenpyramide_STH_ProfessionalX_Vorlage.xlsm")
Set wb_aktPer = myApp.Workbooks.Open(Filename:=pfad & "\Datenbasis Q_KUP akt.xlsx")
Set wb_VPer = myApp.Workbooks.Open(Filename:=pfad & "\Datenbasis Q_KUP V.xlsx")
'aktuelle Periode einfügen
wb_aktPer.Sheets("t_Q_KUP_aktPer").Columns("A:S").Copy Destination:= _
wb_Vorlage.Sheets("Database_akt").Columns("A:S")
wb_aktPer.Close savechanges:=False
'Vorperiode einfügen
wb_VPer.Sheets("t_Q_KUP_VPer").Columns("A:S").Copy Destination:= _
wb_Vorlage.Sheets("Database_V").Columns("A:S")
wb_VPer.Close savechanges:=False
With wb_Vorlage
'Pivot aktuelle Periode aktuallisieren
.Sheets("Pivot_Analyser_akt").PivotTables("PivotTable2").PivotCache.Refresh
'Pivot alte Periode aktuallisieren
.Sheets("Pivot_Analyser_VJ").PivotTables("PivotTable1").PivotCache.Refresh
'Hauptpivot aktualisieren
With .Sheets("Kundenumsatzsegmente")
.PivotTables("PivotTable1").PivotCache.Refresh
.PivotTables("PivotTable3").PivotCache.Refresh
End With
myApp.DisplayAlerts = False
.SaveAs Filename:=pfad & "\" & "NL" & "KUP_Q.xlsm", FileFormat:=52 ' _
xlOpenXMLWorkbookMacroEnabled
.Close
myApp.DisplayAlerts = True
End With
' rst.MoveNext
'Loop
myApp.Quit
'DoCmd.SetWarnings True
MsgBox ("Fertig!")
End Sub

Anzeige
AW: Pivots per VBA aus Access aktualisieren
10.02.2014 18:21:23
Wos
Hi Franz,
vielen Dank für deine Hilfe. Ich habe den Code nun so eingefügt:
Sub kup_Q()
Dim Stelle As Integer
Dim NL As String
Dim txt As String
Dim pfad As String
Dim admsp As String
Dim myApp As New Excel.Application
Dim anzahl As Integer
Dim dbs As Database
Dim rst As Recordset
Dim wb_Vorlage As Excel.Workbook
Dim wb_VPer As Excel.Workbook
Dim wb_aktPer As Excel.Workbook
'recordset aufzeichnen Niederlassungen
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT betriebsstätten.Niederlassung FROM betriebsstätten GROUP BY  _
betriebsstätten.Niederlassung")
'pfad = VBA.Left(pfad, VBA.InStrRev(pfad, "\") - 1)
rst.MoveFirst
myApp.DisplayAlerts = False
DoCmd.SetWarnings False
'Schleifenbeginn mit Niederlassung aus recordset
Do While Not rst.EOF
Stelle = rst.Fields(0)
Forms!Formular1!NL = Stelle
NL = Forms!Formular1!NL
'Access Makro ausführen
DoCmd.RunMacro ("m_Q_kup")
'Excelfiles öffnen
pfad = "K:\Tiefbau2\Kundenpyramiden\Export Q"
pfad = dbs.Name
pfad = VBA.Left(pfad, VBA.InStrRev(pfad, "\") - 1)
Set wb_Vorlage = Excel.Workbooks.Open(FileName:=pfad & "\ _
Kundenpyramide_STH_ProfessionalX_Vorlage.xlsm")
Set wb_aktPer = Excel.Workbooks.Open(FileName:=pfad & "\Datenbasis Q_KUP akt.xlsx")
Set wb_VPer = Excel.Workbooks.Open(FileName:=pfad & "\Datenbasis Q_KUP V.xlsx")
'aktuelle Periode einfügen
wb_aktPer.Sheets("t_Q_KUP_aktPer").Columns("A:S").Copy Destination:=wb_Vorlage.Sheets(" _
Database_akt").Columns("A:S")
wb_aktPer.Close savechanges:=False
'Vorperiode einfügen
wb_VPer.Sheets("t_Q_KUP_VPer").Columns("A:S").Copy Destination:=wb_Vorlage.Sheets("Database_V" _
).Columns("A:S")
wb_VPer.Close savechanges:=False
With wb_Vorlage
'Pivot aktuelle Periode aktuallisieren
.Sheets("Pivot_Analyser_akt").PivotTables("PivotTable2").PivotCache.Refresh
'Pivot alte Periode aktuallisieren
.Sheets("Pivot_Analyser_VJ").PivotTables("PivotTable1").PivotCache.Refresh
'Hauptpivot aktualisieren
With .Sheets("Kundenumsatzsegmente")
.PivotTables("PivotTable1").PivotCache.Refresh
.PivotTables("PivotTable3").PivotCache.Refresh
End With
myApp.DisplayAlerts = False
.SaveAs FileName:=pfad & "\" & "NL" & "KUP_Q.xlsm", FileFormat:=52
' _xlOpenXMLWorkbookMacroEnabled
.Close
myApp.DisplayAlerts = True
End With
rst.MoveNext
Loop
myApp.Quit
DoCmd.SetWarnings True
MsgBox ("Fertig!")
End Sub
Er läuft nun zumindest komplett durch. Was jedoch nicht passiert: Die Daten kommen zwar in die beiden Export-Dateien "Datenbasis_XX", sie werden jedoch nicht in die entsprechenden Reiter der Vorlagedatei kopiert.
Die Aktualisierung der Pivots bleibt zwar im VBA Code nicht stehen, jedoch werden die Pivots augenscheinlich nicht aktualisiert, da sie weiter dieselben Zahlen enthalten obwohl keine Daten in den entsprechenden Reitern verfügbar sind (wurden ja nicht aus den Datenbasis_Dateien kopiert).
Außerdem wird die Vorlage nach der Aktualisierung der Pivottabellen auch nicht unter einem neuen Namen gespeichert.
Ich bin da etwas überfordert muss ich gestehen. Das kopieren hatte ja vorher gut funktioniert.
Kannst du mir da noch weiterhelfen oder sollte ich erst eine Datei erstellen bei der das Makro funktioniert?
Vielleicht sollte ich erwähnen, dass folgende Zeile beim Makro nicht funktniert hat:
pfad = VBA.Left(pfad, VBA.InStrRev(pfad, "\") - 1)
zumindest nicht an der ersten Stelle wo sie auftaucht, weshalb ich diese dann auskommentiert habe.
Viele Grüße
Thias

Anzeige
AW: Pivots per VBA aus Access aktualisieren
11.02.2014 08:14:15
fcs
Hallo Thias,
es ist jetzt schwierig zu beurteilen wo es hängt.
Zumindest währed der Testphase solltest du die neu kreierte Excelanwendung auf den Status Visible (sichtbar) setzen. Dann kannst du durch setzen eines oder mehrerer Haltepunkte im Makro verfolgen was in Excel passiert. Wenn alles funktioniert, dann den Visible-Status auf False setzen.
In der folgeden Passage hast du meinen Vorschlag nicht konsequent umgesetzt:
'Excelfiles öffnen
pfad = "K:\Tiefbau2\Kundenpyramiden\Export Q"
pfad = dbs.Name
pfad = VBA.Left(pfad, VBA.InStrRev(pfad, "\") - 1)
Set wb_Vorlage = Excel.Workbooks.Open(FileName:=pfad _
& "\Kundenpyramide_STH_ProfessionalX_Vorlage.xlsm")
Set wb_aktPer = Excel.Workbooks.Open(FileName:=pfad & "\Datenbasis Q_KUP akt.xlsx")
Set wb_VPer = Excel.Workbooks.Open(FileName:=pfad & "\Datenbasis Q_KUP V.xlsx")

Den Pfad für die Exeldateiein musst du auf deine ursprüngliche Fassung zurücksetzen. Es sei denn die Datenbankdatei und die 3 Excel-Dateien sind im gleichen Verzeichnis gespeichert.
Außerdem hier das Keyword "Excel" durch die Objektvariable der neu kreierten Excelanwendung ersetzen.
'Excelfiles öffnen
pfad = "K:\Tiefbau2\Kundenpyramiden\Export Q"
Set wb_Vorlage = myApp.Workbooks.Open(Filename:=pfad & _
"\Kundenpyramide_STH_ProfessionalX_Vorlage.xlsm")
Set wb_aktPer = myApp.Workbooks.Open(Filename:=pfad & "\Datenbasis Q_KUP akt.xlsx")
Set wb_VPer = myApp.Workbooks.Open(Filename:=pfad & "\Datenbasis Q_KUP V.xlsx")
Ob es nach den Anpassungen dann funktioniert weiss ich nicht.
Gruß
Franz

Anzeige
AW: Pivots per VBA aus Access aktualisieren
11.02.2014 16:04:26
Wos
Hallo Franz,
also ich habe jetzt den Code so angepasst, wie du es meintest. Ich hatte es vorher nicht ganz verstanden.
Und siehe da es funktioniert tadellos!
Besten Dank für die Geduld und die Hilfe sowieso!!
Wenn du magst kannst du mir noch eine Sache erklären. Es scheint als ob die ganze Funktionalität (neben der Verwendung der definierten Excel-Tabelen Wb_Vor etc.) auch an der Definition myApp hängt. Was bewirkt das "myApp"? Wofür ist es gut?
Herzliche Grüße
Thias

AW: Pivots per VBA aus Access aktualisieren
12.02.2014 00:53:57
fcs
Hallo Thias,
in der Variablendeklaration wird mit
Dim myApp As New Excel.Application

der Variablen "myApp" eine neue Excelanwendung zugewiesen, d.h. Excel wird gestartet bzw. ein weiteres mal gestartet.
Damit die weiteren Aktionen funktionieren ist es erforderlich, dass alle Arbeitsmappen in dieser Excelanwendung geöffnet werden. Dies wird dadurch erreicht, dass man statt "Excel" dann die Objektvariable der Anwendung in den entsprechenden Zeilen voranstellt.
Auch bei allen Excel-Anweisungen, die unter Excel-VBA mit "Application." beginnen, muss dann das "Application" durch die Variable ersetzt werden.
Wichtig -speziell wenn man die Excel-Anwendung ausgeblendet ausführt- ist auch, dass man die Excel-Anwendung, nachdem alle Arbeitsmappen wieder geschlossen sind, mit der Anweisung
myApp.Quit

wieder beendet, da die Excelanwendung sonst im Arbeitsspeicher rumgeistert bis der Rechner runtergefahren wird oder man diesen Prozess im Taskmanager manuell beendet.
Gruß
Franz
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige