Question

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

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

我从来没有在Excel中使用过宏，但我想这就是我需要的东西吗？

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

Answer 1

您可以向Shape动态添加按钮Worksheet并使其适合单元格尺寸，然后再向该按钮添加操作。在创建按钮时，您可以在按钮上添加AlternativeText，其中包含Range的地址。之后，在按钮动作中＃39;例程，您可以检索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已复制到剪贴板：

Answer 2

这将在每个单元格中添加一个按钮（在col B中），并设置动作以从同一行中的col 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）

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

2 个答案: