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

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

在这个例子中，列B一个button在按下时应该复制具有相同行号和列E的单元格的内容。

我从来没有在Excel中使用macros，但我想这就是我需要在这里？

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

Answer 1

这将在每个单元格中添加一个button（在列B中），同时将列E中的内容复制到同一行中：

这里是创buildbutton：

 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 

并删除以前创build的所有button的过程（在生成新button之前使用！）

 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 

我还没有find一种方法（但是，我希望）通过作为参数表，所以目前，你必须定义它2次（在Add_Buttons和CopyColE ）

Answer 2

您可以dynamic地添加一个buttonShape到一个Worksheet并适应它的单元格尺寸，然后进一步添加一个动作到该button。 在创buildbutton的时候，你可以添加一个AlternativeText到button的地址Range它被装入。 稍后，在button的“操作”例程中，可以检索Range的地址，以便可以操作该button行上的单元格值 – 包括将该行上的某个单元格值复制到剪贴板。

示例代码：

 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值已被复制到剪贴板：