Question

I have data from pivot-filter I world like to set data branch for select filter

something like this 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

Select with single select after print PDF unselect and select next to finish how to do this code thank you sir (sorry for bad english. I'm not good conversation english)

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

Answer 1

我正在寻找将代码设置到VBA Slicer中的分支。然后通过设置分支字段VBA进行订购打印循环。

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

此代码来自互联网搜索。我尝试搜索此内容，但它的外观仅对从第一个数据到最后一个数据的切片器计数。

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

Set slicer from data branch and print PDF

1 个答案: