Excel/VBA：创建将某些单元格的内容复制到剪贴板的按钮答案

【问题标题】：Excel/VBA: Create button that copies certain cell's content to clipboardExcel/VBA：创建将某些单元格的内容复制到剪贴板的按钮
【发布时间】：2017-01-23 13:15:57
【问题描述】：

我希望每行有一个按钮，可以将该特定行的单元格的内容复制到剪贴板。

在示例中，B 列中的按钮应在按下时复制具有相同行号和列E 的单元格的内容。

我从未在 Excel 中使用过宏，但我想这就是我需要的？

   A | B   | C | D | E      | 
1|   |[BTN]|   |   |'foo'   |
2|   |[BTN]|   |   |'bar'   |
3|   |[BTN]|   |   |'foobar'|
4|   |[BTN]|   |   |        |
5|   |[BTN]|   |   |        |

【问题讨论】：

标签： vba excel

【解决方案1】：

这将在每个单元格（在列 B）中添加一个按钮，操作设置为从同一行中的列 E 复制内容：

这里是创建按钮：

Sub Add_Buttons()
Dim wS As Worksheet
Dim LastRow As Long
Dim i As Long
Dim RgBtn As Range
Dim Btn As Shape

Set wS = ThisWorkbook.Sheets("Sheet1")
LastRow = wS.Range("E" & wS.Rows.Count).End(xlUp).Row

For i = 2 To LastRow
    Set RgBtn = wS.Cells(i, 2)
    Set Btn = wS.Shapes.AddFormControl(xlButtonControl, _
                        RgBtn.Left, RgBtn.Top, RgBtn.Width, RgBtn.Height)

    With Btn
        .OnAction = "'CopyColE " & i & "'"
        .OLEFormat.Object.Text = "Copy test " & i
    End With
Next i
End Sub

以及将 col E 的内容放入剪贴板的代码：

Public Sub CopyColE(ByVal RowIndex As Long)
    Dim wS As Worksheet
    Set wS = ThisWorkbook.Sheets("Sheet1")

    Call CopyText(wS.Range("E" & RowIndex).Value)
End Sub

Public Sub CopyText(Text As String)
    Dim MSForms_DataObject As Object
    Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    MSForms_DataObject.SetText Text
    MSForms_DataObject.PutInClipboard
    Set MSForms_DataObject = Nothing
End Sub

以及删除之前创建的所有按钮的过程（在生成新按钮之前使用！）

Sub Delete_All_Buttons()
Dim wS As Worksheet
Dim Btn As Shape

Set wS = ThisWorkbook.Sheets("Sheet1")

For Each Btn In wS.Shapes
    Btn.Delete
Next Btn

End Sub

我还没有找到一种方法（但我希望）将 Sheet 作为参数传递，所以目前，您必须定义它 2 次（在 Add_Buttons 和 CopyColE 中）

【讨论】：

好东西！会试试看。但是它说将按钮放在B 列中的哪个位置？在LastRow的分配？谢谢
wS.Cells(i, 2) it the 2 ;) 我刚刚测试了新的编辑，它工作得非常好^^
啊，我明白了！ :) 为什么i 从 2 开始？在另一个答案中，按钮从第 2 行开始，也许这就是为什么？
呵呵，只是在第 1 行使用标题的习惯！ ;) 所以只需更改For 循环的开始：For i = 1 To LastRow
哦，当然，本可以看到那个来的，抱歉 =)

【解决方案2】：

您可以将按钮Shape 动态添加到Worksheet 并使其适合单元格尺寸，然后进一步向该按钮添加操作。在创建按钮时，您可以将AlternativeText 添加到带有Range 地址的按钮中。稍后，在按钮“操作”例程中，您可以检索 Range 的地址，以便您可以操作该按钮行上的单元格值 - 包括将该行上的某些单元格值复制到剪贴板。

示例代码：

Option Explicit

Sub CreateButtons()

    Dim ws As Worksheet
    Dim lngRow As Long
    Dim rngButton As Range
    Dim shpButton As Shape

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    'ws.Cells.Delete

    'create a sequence of buttons
    For lngRow = 2 To 11
        'get a range
        Set rngButton = ws.Cells(lngRow, 2)

        'use range properties to define button boundaries
        Set shpButton = ws.Shapes.AddFormControl(xlButtonControl, _
            rngButton.Left, _
            rngButton.Top, _
            rngButton.Width, _
            rngButton.Height)

        'add button properties - action, caption and alt text
        With shpButton
            .OnAction = "DoButtonAction"
            .OLEFormat.Object.Text = "Foo" & lngRow
            ' store the cell address here
            .AlternativeText = rngButton.Address
        End With

        'add a value to column D to use later
        ws.Cells(lngRow, 4).Value = lngRow

    Next lngRow

End Sub

Sub DoButtonAction()

    Dim shp As Shape
    Dim strControlName As String
    Dim strAddress As String
    Dim rngButton As Range

    'get button name
    strControlName = Application.Caller

    'get alternative text which has cell address
    strAddress = ActiveSheet.Shapes(strControlName).AlternativeText

    'get range corresponding to button and do stuff with cells in that row
    Set rngButton = ActiveSheet.Range(strAddress)

    'set a cell value on row of button
    rngButton.Offset(0, 3).Value = rngButton.Offset(0, 2).Value + 1

    'copy cell value for use later
    rngButton.Offset(0, 2).Copy

End Sub

截图单元格中D9的值已复制到剪贴板：

【讨论】：