在整个工作簿中复制元素 [英] Copy the element throughout a whole workbook

问题描述

继续这个问题: TextBox对象自定义-编译错误:无效或不合格的引用

我将复制此元素-文本框到整个文档的所有工作表中.我希望在每个工作表中将它完全放在同一位置.

I am going to copy this element - textbox into all worksheets throughout my document. I would like to have it exactly in the same place in each worksheet.

为此，我使用了代码:

 Sub Asbuildcopy()
 Dim wsh As Worksheet
 Dim ArraySheets As String
 Dim x As Variant


 For Each wsh In ActiveWorkbook.Worksheets

 ActiveSheet.Shapes("Textbox 3").Copy
 Application.Goto Sheets(ArraySheets).Range("Q6")
 ActiveSheet.Paste
 ArraySheets(x) = wsh.Name
        x = x + 1

End Sub

根据此处的建议:

https://www.ozgrid.com/forum/index.php?thread/73851-copy-shape-to-cell-on-another-worksheet/

https://i.stack.imgur.com/lOhJj.png

有关将元素复制到另一张图纸中的说明.

stating about copying an element into another sheet.

除了我的代码外，一个问题是该元素的位置.我将目标单元格用作Q6，但我希望将其与第一张(初始)纸完全放在同一位置.

Apart from my code, one problem is the location of this element. I used target cell as Q6, but I would like to have it exactly in the same place as on the 1st (initial) sheet.

谢谢您的提示，

推荐答案

尝试一下.根据注释，可以使用形状的 Top 和 Left 属性按照第一张纸的形状放置它.

Try this. As per comment, can use the Top and Left properties of a shape to position it as per the first sheet.

为您的实际代码使用更有意义的过程和变量名.

Use more meaningful procedure and variable names for your actual code.

Sub x()

Dim ws As Worksheet, ws1 As Worksheet, s As Shape

Set ws1 = Worksheets("Sheet1")      'sheet containing original textbox
Set s = ws1.Shapes("TextBox 3")     'name of original textbox

Application.ScreenUpdating = False

For Each ws In Worksheets
    If ws.Name <> ws1.Name Then
        s.Copy
        ws.Paste
        ws.Shapes(ws.Shapes.Count).Top = s.Top    
        ws.Shapes(ws.Shapes.Count).Left = s.Left
    End If
Next ws

Application.ScreenUpdating = True

End Sub

这篇关于在整个工作簿中复制元素的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！