Question

我正在创建一个功能，可以在归档旧版本时创建整个工作表的新版本。到目前为止，它正在工作，但我对oleobjects的布局有困难。从本质上讲，他们都是以不正确的各种不同症状粘贴到新表。

我想尝试找到一种方法将复制的对象粘贴到新工作表上的相同位置，因为复制的对象位于旧工作表上。

复制按钮程序非常独立，所以这里完全是这样。（代码现已更新）

  Sub CopyButton(Button As OLEObject, Sht As Worksheet)
Dim NewButton As OLEObject
Dim newButtonName As String


newButtonName = Button.Name
Set NewButton = Button.Duplicate
'With NewButton
'    .TopLeftCell = Sht.Range(Button.TopLeftCell.Address)
'    .Name = Button.Name
'    .Placement = xlMoveAndSize
'End With
NewButton.Cut
With Sht
   .Paste
    .OLEObjects(.OLEObjects.Count).Name = newButtonName
    .OLEObjects(newButtonName).Activate
    .OLEObjects(newButtonName).Placement = xlMoveAndSize
    .OLEObjects(newButtonName).TopLeftCell = .Range(Button.TopLeftCell.Address)
End With
End Sub

我可能不需要所有这些，并且一旦我拥有了我正在寻找的功能，我将继续清理。我认为.Top（根据MS帮助文章是从单元格A1中偏移对象）会有所帮助，但它根本没有帮助。

基本上我正试图这样做，如果原始按钮嵌入原始工作表的Cell D10中，NewButton将嵌入到Sht的Cell D10中。

有没有人有任何想法？

现在更新了目前提出的想法。这是一般的功能更新。

当用注释代码替换当前代码时，按钮在源工作表（我正在复制的那个）中重复，然后当我尝试将TopLeftCell设置为Sht.Range（范围方法为sht）时失败对象失败，因为找不到对象）

使用当前代码时，粘贴作业可以正常工作，但左上角的单元格地址似乎并未实际更改按钮所在位置的坐标。

删除了额外的尝试代码并清理了以下某个答案的尝试。

我找到了一个似乎对我有用的答案。见下文。

Answer 1

我们试试吧。复制按钮，然后使用原始按钮.Address的相对.TopLeftCell。逻辑是：.TopLeftCell返回Range类型对象，该对象具有.Address属性。您可以将该地址限定为sht参数，如下所示：

Sub CopyButton(btn As OLEObject, sht As Worksheet)

Dim newButton As OLEObject

Set newButton = btn.Duplicate
newButton.Cut

With sht
    .Paste
    Set newButton = .OLEObjects(.OLEObjects.Count)
    newButton.TopLeftCell = .Range(btn.TopLeftCell.Address)
End With

End Sub

这也有效，并且完全不依赖于Cut或Paste。所以，它更有效率。

Sub CopyButton2(btn As OLEObject, sht As Worksheet)

Dim newButton As OLEObject

Set newButton = btn.Duplicate
With newButton
    .TopLeftCell = sht.Range(btn.TopLeftCell.Address)
    .Name = btn.Name
End With
End Sub

Answer 2

我得到的东西似乎对我有用。

这是对copybutton过程的调用：

For Each b In OldSht.OLEObjects
    Call CopyButton(b, NewSht)
    NewSht.Rows.AutoFit
Next b

我添加了autofit，因为我正在使用的方法根据它们与纸张顶部和左边的距离（excel的距离测量）定位按钮，这意味着当它将按钮粘贴到新纸张中时，它可能会更改目标工作表行大小（列似乎没有受到影响）。

这是实际的按钮复制代码：

 Sub CopyButton(Button As OLEObject, Sht As Worksheet)
Dim NewButton As OLEObject
Dim NewButtonName As String

NewButtonName = Button.Name
Set NewButton = Button.Duplicate
NewButton.Cut

With Sht
    .Paste
    .OLEObjects(.OLEObjects.Count).Name = NewButtonName
    With .OLEObjects(NewButtonName)
        .Top = Button.Top
        .Left = Button.Left
    End With
End With
End Sub

这成功地将源表格中的所有200多个按钮复制到目标工作表中，并使它们在新工作表中占据相同的位置。我不确定为什么TopLeftCell不起作用，但这种方法适用于文档的绝对位置。如果你正在寻找一个更间接的定位，这是行不通的。

这意味着虽然这看起来确实有效，但两张纸的格式都是不可或缺的，必须仔细管理才能使其正常工作。

将复制的oleobject粘贴到同一位置的新工作表中

2 个答案: