DisplayAlert automatisch beantworten

Einen wunderschönen Sonntagnachmittag,
diese Forum ist seiter immer meine Rettung gewesen - bis heute ;-).
Die Aufgabe
Ich filtere Daten in einer Pivottabelle (verschiedene Filialen nach Nummer). Ein Makro versendet mir ein automatisch generiertes .pdf per Mail, nachdem die entsprechende Filiale ausgewählt wurde. Im übrigen alles aus diesem Forum gelernt.
Nun mein Problem:
Wähle ich eine Filiale aus, die an dem betimmten Tag (der auch ausgewählt wird) keine Daten liefert kommt die Meldung:
"Es gibt kein Element mit diesem Namen in der Pivottabelle. 3050 in 3062 umwandeln?"
Diese Meldung soll automatisch abgebrochen werden, denn es darf nicht umgewandelt werden.
Application.displayalerts = false geht lerider nicht, da dann automatisch umgewandelt wird.
hier mein Skript:
Sheets("Backwaren_Tag").Select
Range("C9").Select
ActiveSheet.PivotTables("PivotTableBWT").PivotFields("Fachgeschäft:"). _
CurrentPage = "3001"
ActiveSheet.PivotTables("PivotTableBWT").PivotFields("Datum:").CurrentPage = _
Date - 1
Dim olApp As Object
Dim xlNewFileName As String
Dim olOldBody As String
Rem Pfad und Name für PDF-Datei
xlNewFileName = Environ("USERPROFILE") & "\Documents\Emailversand\" & Range("Backwaren_Tag!A1") & ".pdf"
Rem PDF-Datei erstellen
Dim Variable As Variant
D = Workbooks("Kennzahlen.xlsm").Worksheets("Backwaren_Tag").Range("A2").Value
Range("Backwaren_Tag!" & D).ExportAsFixedFormat Type:=xlTypePDF, Filename:=xlNewFileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Rem Email erstellen
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
.to = "werauchimmer@wohinauchimmer.de"
.Subject = "Backwarenretoure Tag"
.Attachments.Add xlNewFileName
.htmlBody = "" & olOldBody
.send
End With
Für Ideen bin ich unendlich dankbar

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Epp,
die Behandlung von Zahlenwerten und insbesondere Datumswerten als Pivot-Items ist unter VBA extrem mühsam, da die Daten im Hintergrund im US-Format verwaltet werden.
Probiere mal ob du mit den folgenden Anpassungen weiterkommst.
Die zu setzenden Pivot-Items im Seitenbereich werden jeweils in einer Schleife geprüft, ob Daten vorhanden sind.
Die Anzeige der Meldungen kannst du ja auskommentieren, wenn alles funktioniert.
Gruß
Franz

Sub aaaTest()
Dim pvTab As PivotTable, pvField As PivotField, pvItem As PivotItem
Dim varFiliale, varItem, varDatum
Sheets("Backwaren_Tag").Select
Range("C9").Select
Set pvTab = ActiveSheet.PivotTables("PivotTableBWT")
pvTab.RefreshTable
Set pvField = pvTab.PivotFields("Fachgeschäft:")
pvField.ClearAllFilters
pvTab.PivotFields("Datum:").ClearAllFilters
varFiliale = "3070"
For Each pvItem In pvField.PivotItems
If pvItem.Caption = varFiliale Then
If pvItem.RecordCount > 0 Then
pvField.CurrentPage = varFiliale
Exit For
End If
End If
Next
If Not pvItem Is Nothing Then
Set pvField = pvTab.PivotFields("Datum:")
varItem = Format(Date - 1, "M\/D\/YYYY")
varDatum = Format(Date - 1, "DD.MM.YYYY")
For Each pvItem In pvField.PivotItems
If pvItem.Caption = varItem Then
If pvItem.RecordCount > 0 Then
pvField.CurrentPage = Date - 1
Exit For
End If
End If
Next
If Not pvItem Is Nothing Then
Dim olApp As Object
Dim xlNewFileName As String
Dim olOldBody As String
Dim D As String
Rem Pfad und Name für PDF-Datei
xlNewFileName = Environ("USERPROFILE") & "\Documents\Emailversand\" _
& Range("Backwaren_Tag!A1") & ".pdf"
Rem PDF-Datei erstellen
D = Workbooks("Kennzahlen.xlsm").Worksheets("Backwaren_Tag").Range("A2").Value
Range("Backwaren_Tag!" & D).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=xlNewFileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Rem Email erstellen
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.display
olOldBody = .htmlBody
.to = "werauchimmer@wohinauchimmer.de"
.Subject = "Backwarenretoure Tag"
.Attachments.Add xlNewFileName
.htmlBody = "" & olOldBody
'            .display
.send
End With
Else
MsgBox "Keine Daten für Filiale """ & varFiliale & """ am " _
& varDatum & " vorhanden!"                      'Testzeile
End If
Else
MsgBox "Keine Daten für Filiale """ & varFiliale _
& """ vorhanden!"                                   'Testzeile
End If
End Sub

Beliebteste Forumthreads (12 Monate)

DisplayAlert automatisch beantworten

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread