我有来自枢轴过滤器的数据我喜欢为选择过滤器设置数据分支
像这样的东西 001 Great Northern << select 002 Great Eastern << select 003 Great Southen << not select 004 Great Midland << Not select 015 Great Mainline Transport << Select 025 Great Asia Industy << not select 030 Great Deutscher << Select
在打印 PDF 取消选择后选择单选并选择下一步以完成如何执行此代码谢谢先生（抱歉英语不好。我的英语会话不好）
Sub Button99_PDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim codebranch As String
Dim branchname As String
Dim lictype As String
On Error GoTo errHandler
Dim tblRaw As ListObject, tblFiltered As ListObject
Dim sh_raw As Worksheet, sh_filtered As Worksheet
Dim critRange As Range, copyToRng As Range, resizeRng As Range
Dim startRow As Long, lastRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Sheets("Pivot_Filters").Range("a8").Value = "" Then Exit Sub
Set wsPF = ThisWorkbook.Sheets("Pivot_Filters")
Set wsSD = ThisWorkbook.Sheets("SalesData")
Set wsOP = ThisWorkbook.Sheets("Output")
Set tblFiltered = wsOP.ListObjects("table2")
Set ws = ThisWorkbook.Sheets("Output")
Select Case tblFiltered.ListRows.Count
Case Is > 0
tblFiltered.DataBodyRange.Delete
tblFiltered.ListRows.Add
Case Else
tblFiltered.ListRows.Add
End Select
For Each slcCache In ActiveWorkbook.SlicerCaches
slcCache.ClearManualFilter
Next
With ActiveWorkbook.SlicerCaches("Slicer_รหัส_สาขา")
For Each oSlicerItem In .SlicerItems
If oSlicerItem.Name = "001 : วิภาวดี" Then
oSlicerItem.Selected = True
Else
oSlicerItem.Selected = False
End If
With ActiveWorkbook.SlicerCaches("Slicer_ประเภท_ใบอนุญาต")
.SlicerItems("ตัวแทน").Selected = True
.SlicerItems("Micro Insurance").Selected = True
.SlicerItems("นายหน้าบุคคล").Selected = False
.SlicerItems("นายหน้านิติบุคคล").Selected = False
.SlicerItems("พรบ.").Selected = True
.SlicerItems("นายหน้า").Selected = False
.SlicerItems("โบรคเกอร์").Selected = False
.SlicerItems("ไม่มีบัตร").Selected = False
.SlicerItems("FALSE").Selected = False
End With
With ActiveWorkbook.SlicerCaches("Slicer_ชื่อหลักสูตร")
.SlicerItems("ขอต่อใบอนุญาตนายหน้าประกันวินาศภัยครั้งที่ 1").Selected = True
.SlicerItems("ขอต่อใบอนุญาตนายหน้าประกันวินาศภัยครั้งที่ 2").Selected = True
.SlicerItems("ขอต่อใบอนุญาตนายหน้าประกันวินาศภัยครั้งที่ 3").Selected = True
.SlicerItems("ขอต่อใบอนุญาตนายหน้าประกันวินาศภัยครั้งที่ 4").Selected = True
.SlicerItems("ขอรับใบอนุญาตนายหน้าประกันวินาศภัย").Selected = True
.SlicerItems("ขอต่อใบอนุญาตตัวแทนประกันวินาศภัยครั้งที่ 1").Selected = True
.SlicerItems("ขอต่อใบอนุญาตตัวแทนประกันวินาศภัยครั้งที่ 2").Selected = True
.SlicerItems("ขอต่อใบอนุญาตตัวแทนประกันวินาศภัยครั้งที่ 3").Selected = True
.SlicerItems("ขอต่อใบอนุญาตตัวแทนประกันวินาศภัยครั้งที่ 4").Selected = True
.SlicerItems("ขอรับใบอนุญาตตัวแทนประกันวินาศภัย").Selected = True
.SlicerItems("ไม่มีข้อมูล").Selected = False
End With
ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight21"
wsSD.Range("Sales_Data[#All]").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wsPF.Range("CritSlicers"), _
CopyToRange:=wsOP.Range("ExtractSlicers"), _
Unique:=False
'Find Filtered table Header row
startRow = tblFiltered.HeaderRowRange.Row
'Find last row on Filtered tab (deduct 1 since Advanced filter retrieves the headers)
lastRow = wsOP.Columns(2).Find("*", , , , xlByRows, xlPrevious).Row
'If the last raw is greater than the Header row, resize the Filtered table and delete the retrieved Headers (which will be in the first row of the Filtered table)
If lastRow > startRow Then
Set resizeRng = Range("table2[#All]").Resize(tblFiltered.Range.Rows.Count + (lastRow - startRow - 1), tblFiltered.Range.Columns.Count)
tblFiltered.Resize resizeRng
' tblFiltered.ListRows(2).Delete
Else
'If the last row is equal to Header row it means only the Column headers have been fetched, so there is no matching row to the filter criterias
'The if condition is only for let's say second line of defence
If tblFiltered.HeaderRowRange(11, 2) = tblFiltered.DataBodyRange(11, 2) Then
tblFiltered.DataBodyRange.Delete
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.Worksheets("Output").ListObjects("Table2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Output").ListObjects("Table2").Sort.SortFields.Add2 _
Key:=Range("Table2[ครั้งที่]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Output").ListObjects("Table2").Sort.SortFields.Add2 _
Key:=Range("Table2[วัน" & Chr(10) & "หมดอายุ]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Output").ListObjects("Table2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets("Output").Columns("A:M").AutoFit
Worksheets("Output").Columns("K").Hidden = True
Worksheets("Output").PageSetup.PrintArea = "PrintFocus"
stword3 = GetSelectedSlicerItems("Slicer_รหัส_สาขา")
stword = "รายงานต่อใบอนุญาต"
stword4 = "ประกันวินาศภัย"
stword5 = GetSelectedSlicerItems2("Slicer_ประเภท_ใบอนุญาต")
Range("A9") = stword & " " & stword3 & " " & stword5 & " " & stword4
If InStr(Range("a9").Value, "นายหน้า") > 0 Then
lictype = "นายหน้า"
ElseIf InStr(Range("a9").Value, "ตัวแทน") > 0 Then
lictype = "ตัวแทน"
ElseIf InStr(Range("a9").Value, "ใบอนุญาตทั้งหมด") > 0 Then
lictype = "ร่วมใบอนุญาต"
End If
codebranch = GetSelectedSlicerItems3("Slicer_รหัส_สาขา")
branchname = GetSelectedSlicerItems("Slicer_รหัส_สาขา")
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd_mm_yy")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = lictype & "_" & codebranch & "_" & branchname & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
Next oSlicerItem
End With
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub