vba直接复制button
我知道我可以做点什么
range("C1:D1").copy destination:=range("C2:D2") 对于范围，我想知道如果我可以做同样的forms控制button
当前的代码如果find，则复制该button，然后将该button添加到写入“哈希标记”的单元格中。 在这个例子中“#Button返回摘要＃”。 这一切工作正常，但我想改变代码不去通过剪贴板，例如像上面的代码范围，但为表单button。
调用代码：
On Error Resume Next Cells.Find(What:="#Button Back To Summary#", After:=ActiveCell, LookIn:= _ xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _ , MatchCase:=False, SearchFormat:=False).Activate If Err.Number = 0 Then addshapetocell ActiveCell, "BK_TO_SUMMARY" End DoEvents On Error GoTo 0
addshapetocell（）
Sub addshapetocell(p As Range, btn_Name As String) Dim clLeft As Double Dim clTop As Double Dim cl As Range Dim r As Integer, R1 As Integer On Error GoTo 0 R1 = 0 r = 0 Set cl = Range(p.Address) clLeft = cl.Left clTop = cl.Top cl.value = "" retryer: update_Working_Status Application.CutCopyMode = False DoEvents If r > 5000 Or R1 > 700 Then MsgBox "Code has attempted to copy a button 5000 times and has failed each time" Stop End If Worksheets("Odds").Shapes(btn_Name).Copy DoEvents If Application.ClipboardFormats(1) = 0 Then R1 = R1 + 1 Sleep (50) GoTo retryer End If With ActiveSheet On Error Resume Next .Paste If Err.Number = 1004 Then On Error GoTo 0 r = r + 1 Sleep (50) GoTo retryer ElseIf Err.Number <> 0 Then Stop 'unhandled error has happend End If On Error GoTo 0 .Shapes(btn_Name).Left = clLeft .Shapes(btn_Name).Top = clTop End With End Sub
编辑：update_Working_Status更新状态栏与“工作”。 ＆“工作..”等
我不相信有一种方法可以直接将Shape从一个Worksheet复制到另一个不使用剪贴板。 有一个.Duplicate方法，但我不知道有一种方法来改变形状父亲即。 它属于哪个工作表。
你有没有考虑以编程方式重新创build形状使用您的模板形状作为基地？ 这将有效地复制形状，但涉及更多的努力。 我已经写了下面的例子来说明你如何做到这一点，希望你能适应你的确切需求。
Dim wb As Workbook Set wb = Application.ActiveWorkbook ' Worksheet Receiving the Template Shape ie. the ActiveSheet. Dim ws As Worksheet Dim rng As Range Dim newShape As Shape Set ws = wb.ActiveSheet Set rng = ws.Range("B10") ' Destination Cell. ' Worksheet containing the Template Shape. Dim wsTemplate As Worksheet Dim shapeToCopy As Shape Set wsTemplate = wb.Sheets("Template") ' The Worksheet containing template button. Set shapeToCopy = wsTemplate.shapes("#example") ' The name of template button. ' Different 'Shapes' are created via different Methods, so check the types that you want ' to support and implement the Method as appropriate. Select Case shapeToCopy.Type Case MsoShapeType.msoFormControl ' Create the 'new' Shape based on the type and size of the template, and the location of the receiving Cell. Set newShape = ws.shapes.AddFormControl(shapeToCopy.FormControlType, rng.Left, rng.Top, shapeToCopy.Width, shapeToCopy.Height) newShape.OLEFormat.Object.Text = shapeToCopy.OLEFormat.Object.Text ' Copy the template buttons caption. Case Else ' Unsupported Shape Type Exit Sub End Select ' Now "Copy" the remaining shared Shape properties that we want to retain from the template. newShape.Name = shapeToCopy.Name newShape.AlternativeText = shapeToCopy.AlternativeText newShape.OnAction = shapeToCopy.OnAction ' The name of the routine to run on button click ' etc... ' etc...
在sheet1中，我有一个不可见的activeX控件（Oleobject）：commandbutton1它可以放置在“哈希标记”单元旁边，使用：
Sub M_snb() With Cells.Find("hash tag").Offset(, 1) Sheet1.CommandButton1.Top = .Top Sheet1.CommandButton1.Left = .Left Sheet1.CommandButton1.Visible = True End With End Sub