AW: Datenschnitt Pivot, jedes Element drucken
06.01.2014 01:09:52
fcs
Hallo Tim,
alle Ausdrucke in ein PDF-File funktioniert nicht ohne weiteres.
Hier ist es einfacher, alle Datenschnitte in Einzeldateien zu speichern und diese dann mit einem Tool (z.B. Adobe Acrobat oder FreePDF-Join) in einer PDF-Datei zusammenzufassen.
Nachfolgend 2 Makros, die du bezüglich des Namens des Datenschnitts noch anpassen musst.
Gruß
Franz
Sub DatenSchnitteDrucken()
' Datenschnitte Drucken
Dim objSlicerItem As SlicerItem, objSlicerCache As SlicerCache
Dim intItem As Integer
Dim wks As Worksheet
Set wks = ActiveSheet
Set objSlicerCache = ActiveWorkbook.SlicerCaches("Datenschnitt_Feld03") 'Name anpassen, _
ggf. mit Makrorekorder Datenschnittselektion aufzeichnen.
objSlicerCache.ClearManualFilter
If objSlicerCache.SlicerItems.Count > 1 Then
For intItem = 2 To objSlicerCache.SlicerItems.Count
objSlicerCache.SlicerItems(intItem).Selected = False
Next
wks.PrintOut
For intItem = 2 To objSlicerCache.SlicerItems.Count
objSlicerCache.SlicerItems(intItem).Selected = True
objSlicerCache.SlicerItems(intItem - 1).Selected = False
wks.PrintOut
Next
Else
wks.PrintOut
End If
End Sub
Sub DatenSchnitteMakePDFs()
' Datenschnitte als PDFs speichern
Dim objSlicerItem As SlicerItem, objSlicerCache As SlicerCache
Dim intItem As Integer, strNamePDF
Dim wks As Worksheet
Set wks = ActiveSheet
Set objSlicerCache = ActiveWorkbook.SlicerCaches("Datenschnitt_Feld03") 'Name anpassen, _
ggf. mit Makrorekorder Datenschnitt-Filterselektion aufzeichnen.
objSlicerCache.ClearManualFilter
If objSlicerCache.SlicerItems.Count > 1 Then
For intItem = 2 To objSlicerCache.SlicerItems.Count
objSlicerCache.SlicerItems(intItem).Selected = False
Next
strNamePDF = ActiveWorkbook.Path & "\" & Format(1, "0000") _
& objSlicerCache.SlicerItems(1).Name & ".pdf"
wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strNamePDF, _
Quality:=xlQualityStandard, includedocproperties:=True, _
ignoreprintareas:=False, openafterpublish:=False
For intItem = 2 To objSlicerCache.SlicerItems.Count
objSlicerCache.SlicerItems(intItem).Selected = True
objSlicerCache.SlicerItems(intItem - 1).Selected = False
strNamePDF = ActiveWorkbook.Path & "\" & Format(intItem, "0000") _
& objSlicerCache.SlicerItems(intItem).Name & ".pdf"
wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strNamePDF, _
Quality:=xlQualityStandard, includedocproperties:=True, _
ignoreprintareas:=False, openafterpublish:=False
Next
Else
strNamePDF = ActiveWorkbook.Path & "\" & Format(1, "0000") _
& objSlicerCache.SlicerItems(1).Name & ".pdf"
wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strNamePDF, _
Quality:=xlQualityStandard, includedocproperties:=True, _
ignoreprintareas:=False, openafterpublish:=False
End If
End Sub