Ich frage Daten von einem MS_SQL-Server mit Power Query ab und lade diese Daten in eine Tabelle innerhalb eines Arbeitsblattes. Bei den Daten handelt es sich um eine Baugruppen-Strukturstückliste. Die Datenübergabe funktioniert zuverlässig. Die optische Aufbereitung der Daten ist sehr spartanisch. Als Lösung bot sich an, den Ergebnisbereich mit VBA optisch etwas aufzupeppen. Zellhintergrund entsprechend des Zeileninhaltes bunt eingefärbt, horizontale Ausrichtung definiert, Schriftfarbe definiert und Zahlenformat festgelegt.
Buttongesteuert aktualisiere ich zunächst die Abfragen und arbeite dann die Formatierung ab. Letztere wird zunächst sauber ausgeführt, abschließend aber (ausschließlich) die Zahlenformate wieder überschrieben. Die bunten Zeilen und die Zellausrichtung bleibt bestehen. Arbeitet man den Code im Debug-Mode ab, steht die Formatierung wie definiert inklusive der Zahlenformate. Arbeitet man den Code in Echtzeit ab, blitzt die gewünschte Formatierung zunächst kurz auf und wird dann überschrieben.
Was ich bereits abgearbeitet habe:
Alle Haken bei den externen Dateieigenschaften aller Aktualisierungs-Abfragen rausgenommen. Keine Änderung.
Alle Hintergrundabfragen deaktiviert. Keine Änderung.
Zwischen Abfrage und Formatierung eine satte Warteschleife eingebaut, damit die Formatierung definitiv erst dann startet, wenn die Abfrage beendet ist. Keine Änderung
Das Sub zur Formatierung solo gestartet. Formatierung erfolgt wir gewünscht. Ein Workaround wäre somit möglich.
Und ja, es wäre sinnvoll, die Datei hochzuladen. Da dann die Abfrage aber nicht läuft, macht das m.E. wenig Sinn. Wie kann man so etwas simulieren? Den Code des Moduls hänge ich an.
Die Kernfrage: Warum funktioniert das nicht in Kombination mit der Aktualisierungs-Abfrage?
Danke schon mal
Peter B
Option Explicit
Sub Modul_1_Hauptprogramm()
Sheets("Auftragskalkulation").Select
'Daten aktualisieren
Abfrage_aktualisieren 'Sub
' Plausibilitätsdaten, ob Auftrag aktuell
Sheets("Auftragskalkulation").Range("B2").Copy
Sheets("Auftragskalkulation").Range("E2").PasteSpecial xlPasteValues
'Plausibilitätsdaten, ob Position aktuell
Sheets("Auftragskalkulation").Range("B3").Copy
Sheets("Auftragskalkulation").Range("E3").PasteSpecial xlPasteValues
'Plausibilitätskontrolle, ob VErkaufspreis zu AMS übertragen ist
Sheets("Auftragskalkulation").Range("S12").Copy
Sheets("Auftragskalkulation").Range("E4").PasteSpecial xlPasteValues
Application.Wait 20000
'Tabelle Auftragskalkulation formatieren
Auftragskalkulation_Formatierung 'Sub
End Sub
Sub Abfrage_aktualisieren()
Dim SucheVerbindung As Long 'Sucht Verbindungszeichenfolge
Dim Datenverbindung As WorkbookConnection ' für einzelne Datenverbindungen
On Error Resume Next
'Gehe durch jede Datenverbindung und súche Verbindungszeichenfolge
For Each Datenverbindung In ThisWorkbook.Connections
SucheVerbindung = InStr(1, Datenverbindung.OLEDBConnection.Connection, "Provider=Microsoft.Mashup.OleDb.1", vbTextCompare)
'Sollte die Textkette nicht gefunden werden, erhält SucheVerbindung keinen Wert und es gibt einen Fehler
If Err.Number 0 Then
Err.Clear
Exit For
End If
'Wurde die Schleife bis hierher nicht abgebrochen und die Textkette gefunden, wird die Verbindung aktualisiert
If SucheVerbindung > 0 Then Datenverbindung.Refresh
Next Datenverbindung
End Sub
Sub Auftragskalkulation_Formatierung()
'Neuberechnung abschalten
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Auftragskalkulation").Activate
'*** Formatierung Kopfzeile Ergebnisbereich
Range("BK_PDM_Auftragskalkulation[#Headers]").Select
With Selection.Font
.Name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Autofilter abschalten
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
'Selection.AutoFilter
'Vorhandene Formatierung löschen
Range("BK_PDM_Auftragskalkulation").ClearFormats
'*** Spaltenformatierung Ergebnisbereich
'BDE-Nummer
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[BDE_NR]]").Select
Selection.ColumnWidth = 8
Selection.HorizontalAlignment = xlLeft
'Ebene
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Ebene]]").Select
Selection.ColumnWidth = 6.5
Selection.HorizontalAlignment = xlCenter
'Komponente
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Komponente]]").Select
Selection.EntireColumn.AutoFit
'Menge
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Menge]]").Select
Selection.ColumnWidth = 4.25
Selection.HorizontalAlignment = xlCenter
'Gesamtmenge
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Gesamtmenge]]").Select
Selection.ColumnWidth = 9
Selection.HorizontalAlignment = xlCenter
'Materialposition
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[MatPos]]").Select
Selection.ColumnWidth = 4.75
Selection.HorizontalAlignment = xlCenter
' PosArt schmäler
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[PosArt]]").Select
Selection.ColumnWidth = 6
Selection.HorizontalAlignment = xlCenter
'Dispoart schmäler
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Dispoart]]").Select
Selection.ColumnWidth = 5
Selection.HorizontalAlignment = xlCenter
'Artikel Spaltenbreite schmäler
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[MatArt]]").Select
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlCenter
'Material-Einzelpreis
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Mat_Einzelpreis]]").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlRight
'Material-Gesamtmenge
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Mat_Gesamtmenge]]").Select
Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
Selection.HorizontalAlignment = xlCenter
'FK_ST Fertigkennung Stückliste
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[FK_ST]]").Select
Selection.ColumnWidth = 5
Selection.HorizontalAlignment = xlCenter
'AgPos Arbeitsgangposition
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[AgPos]]").Select
Selection.ColumnWidth = 5
Selection.HorizontalAlignment = xlCenter
'Gesamtstunden Spaltenbreite schmäler wegen Positionsangaben
Range("BK_PDM_Auftragskalkulation[Gesamtstunden]").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
Selection.ColumnWidth = 10
'Stundensatz
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Stundensatz]]").Select
Selection.ColumnWidth = 7.5
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'FK_AG Spaltenbreite schmäler wegen Fehlermeldungen
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[FK_AG]]").Select
Selection.ColumnWidth = 5
Selection.HorizontalAlignment = xlCenter
'Gesamtpreis AMS
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Gesamtpreis]]").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'Zeilenpreis
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Zeilenpreis]]").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'Zeilensummen
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Zeilensumme]]").Select
Selection.FormatConditions.Delete
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'Selection.EntireColumn.AutoFit
'Symbol
Range("BK_PDM_AUFTRAGSKALKULATION[[#All],[Symbol]]").Select
Selection.FormatConditions.Delete
'Selection.EntireColumn.AutoFit
Selection.HorizontalAlignment = xlCenter
'*** Farbliche Darstellung des Ergebnisbereichs der Strukturabfrage
Dim Anzahl_Spalten As Integer
Dim Anzahl_Zeilen As Integer
Dim Ergebnisbereich As Object
Dim z As Integer ' Laufvariable Zeilenbearbeitung
Dim s As Integer ' Laufvariable Spaltenbearbeitung
Range("BK_PDM_Auftragskalkulation[#All]").Select
Set Ergebnisbereich = Range("BK_PDM_Auftragskalkulation[#All]")
Anzahl_Spalten = Selection.Columns.Count
Anzahl_Zeilen = Selection.Rows.Count
'Zeilenweise Farbformatierung abhängig vom Zellinhalt der Spalte "SYMBOL" und "Ebene"
' für maximal 3 Ebenen
For z = 1 To Anzahl_Zeilen
Ergebnisbereich.Cells(z, 3).Select
Select Case True
Case Ergebnisbereich.Cells(z, 26).Value = "SYMBOL"
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Select
Selection.Interior.Color = RGB(244, 176, 132) ' Kopfzeile
Selection.Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 1
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(38, 79, 169) ' Komponente Ebene 1
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 2
Ergebnisbereich.Cells(z, s).Font.Bold = False
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 2
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(49, 99, 212) ' Komponente Ebene 2
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 2
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 3
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(56, 115, 255) ' Komponente Ebene 3
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 2
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 4
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(88, 149, 255) ' Komponente Ebene 4
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 5
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(131, 177, 255) ' Komponente Ebene 5
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "K" And Ergebnisbereich.Cells(z, 2).Value = 6
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.Color = RGB(177, 205, 255) ' Komponente Ebene 6
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "m"
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Interior.ColorIndex = 15 'Material
Ergebnisbereich.Cells(z, s).Font.ColorIndex = 1
Next s
Case Ergebnisbereich.Cells(z, 26).Value = "a"
For s = 1 To Anzahl_Spalten
Ergebnisbereich.Cells(z, s).Select
Selection.Interior.ColorIndex = 2 'Arbeitsgang
Selection.Font.ColorIndex = 1
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Next s
End Select
Next z
'*** Zellenformatierung Kopfbereich
' Summe Gesamtpreis AMS
Range("Q10").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
' Gemeinkostenzuschlag AMS
Range("Q11").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
' Verkaufspreis AMS
Range("Q12").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
' Summe Gesamtpreis AMSCalc
Range("Y10").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
' Gemeinkostenzuschlag AMSCalc
Range("Y11").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
' Verkaufspreis AMSCalc
Range("Y12").Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
'*** Neuberechnung einschalten
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call Calculate
End Sub