VBA切片器复制方法

Question

我对VBA和Excel Macro完全陌生，我想做的就是这样：

我希望在单击切片器中的数据后将其自动复制到剪贴板中。

我的切片器名称是：Slicer_Internal_Punter_ID

如果您仍然需要其他信息，请告诉我。 我以为这很容易，但是我现在要疯了。

谢谢。 我会很高兴的。

这是切片机的详细信息

。

Answer 1

您可以使用以下过程和事件来获取所选项目的名称。

将此过程添加到任何模块，然后使用立即窗口（“查看/立即”窗口）读取并复制SliceCache的正确名称。 需要在其他代码段中使用它。

Sub GetSlicerData()

    '## Variables ##

    Dim iSlicerCache            As SlicerCache      'Slicer Cache Object
    Dim iSlicerItem             As SlicerItem       'Slicer Item
    Dim iSlicer                 As Slicer           'Slicer Object

    '## Looping through Slicer Caches in 'ThisWorkbook' ##

    For Each slSlicerCache In ThisWorkbook.SlicerCaches

        Debug.Print ("Slicer Cache Namee: " & slSlicerCache.Name)   'Printing the name property of the SlicerCaches

        '## Looping through Slicers contained in the SlicerCaches ##

        For Each iSlicer In slSlicerCache.Slicers
                Debug.Print ("Slicer Name: " & iSlicer.Name)    'Printing the slicer names
                Next iSlicer

        '## Looping through Items contained in the SlicerCaches ##
                    'and testing selection status

        For Each iSlicerItem In slSlicerCache.SlicerItems
                If iSlicerItem.Selected = True Then Debug.Print ("Selected Item: " & iSlicerItem.Name)                            'Printing the slicer items
                Next iSlicerItem

        Next slSlicerCache

        End Sub

第二个片段是一个工作表事件，必须将其添加到受切片器影响的工作表中。

双击宏编辑器中的工作表（项目浏览器窗口）以添加代码： 将事件添加到工作表中

第二个片段将选定的项目打印到立即窗口。

Private Sub Worksheet_Change(ByVal Target As Range)

        'Debug.Print ("Sheet name: " & Me.Name)  'Sheet name

    '## Looping through Slicer Caches in 'ThisWorkbook' ##

    Dim slcSlicerCache          As SlicerCache      'Slicer Cache Object
    Dim iSlicerItem             As SlicerItem       'Slicer Item

    Dim stItems                 As String

    '## Setting slicer cache ##

    'Replace with the correct name: "Slicer_Internal_Punter_ID"

    Set slcSlicerCache = ThisWorkbook.SlicerCaches("Slicer_Internal_Punter_ID")

    For Each iSlicerItem In slcSlicerCache.SlicerItems
                If iSlicerItem.Selected = True Then

                Debug.Print ("Selected Item: " & iSlicerItem.Name)  'Printing selected

                    If Len(stItems) = 0 Then stItems = iSlicerItem.Name Else stItems = stItems & vbNewLine & iSlicerItem.Name

                End If
                Next iSlicerItem

                Debug.Print ("Selected Items: " & vbNewLine & stItems)  'Printing selected

                    'ADD CODE HERE: moving content to clipboard

    End Sub

请注意在此行中使用切片器的正确名称：

Set slcSlicerCache = ThisWorkbook.SlicerCaches("Slicer_Internal_Punter_ID")

此外，要将项目名称发布到剪贴板，您可以检查以下链接： 如何将文本复制到剪贴板