Excel VBA - 如何从工作簿B传输形状并替换工作簿A中的特定现有形状？

Question

预先感谢您的任何帮助。我的知识是初级水平。我可以阅读代码，但很难写作。我不确定这个最新错误指的是哪一行。

此外，我认为总是有更好（更有效）的方法来编写代码。

这篇文章发布在这篇文章之后：VBA Excel - How to transfer Values of Named Ranges from Workbook B into same/similar Named Ranges in Workbook A?

在对许多错误进行故障排除后，我终于收到错误：对象不支持此属性或方法。

第一篇参考文章：excel Copy shapes from one worksheet to another

第二篇参考文章：https://superuser.com/questions/1042887/naming-an-object-in-excel-vba-so-it-can-be-selected-once-its-copied-to-another

问题：形状将复制但无法正确定位。它命名正确。

我正在尝试以下方面： 1.在工作簿A中存储特定形状的形状属性 2.从工作簿B复制特定的命名形状 3.将复制的形状粘贴到工作簿A中的特定工作表中 4.将存储的形状属性应用于复制的形状

以下是所有代码：

Sub Button_Transfer_FromOlderVersion()

' Start of Error Handling
    On Error GoTo Errorcatch

' Declare string variable and use current open workbook filename as value
    Dim WorkbookNameNew As String
    WorkbookNameNew = ThisWorkbook.Name

' Declare string variable for 2nd workbook not yet identified
    Dim WorkbookNameOld As String

' Find out the name of the 2nd workbook
' Declare string variable for finding and separating the filename from the path
    Dim OldWorkbookFileName As String

' Show the open dialog and pass the selected file name to the string variable "OldWorkbookFileName"
    OldWorkbookFileName = Application.GetOpenFilename

' If the user cancels finding the workbook file then exit subroutine
    If OldWorkbookFileName = "False" Then Exit Sub

' Troubleshooting: Show me the filename with path of Workbook B
'    MsgBox OldWorkbookFileName

' Troubleshooting: Show me the filename of Workbook A
'    MsgBox WorkbookNameNew

' Open Workbook B which the user just selected
    Workbooks.Open Filename:=OldWorkbookFileName

' Separate the filename from the path for Workbook B
    WorkbookNameOld = Dir(OldWorkbookFileName)

' Troubleshooting: Show me the filename of Workbook B
'    MsgBox WorkbookNameOld

' Temporarily change some settings to speed up the transfer process
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

' Transfer Values of Named Ranges from Workbook B
' Workbooks(WorkbookNameNew).Worksheets("WorksheetName").Range("NamedRange01").Value = Workbooks(WorkbookNameOld).Worksheets("WorksheetName").Range("NamedRange01").Value

' Unprotect specific Worksheet in Workbook A to help eliminate transfer issues of shapes
    Sheet05.Unprotect Password:="MyPassword"

' Declare all variables
    Dim worksheet01 As Worksheet
    Dim worksheet02 As Worksheet
    Dim PictureName01 As String
    Dim PictureName02 As String
    Dim shape01 As Shape
    Dim shape02 As Shape
    Dim shape03 As Shape
    Dim shapeTop As Long
    Dim shapeLeft As Long
    Dim shapeHeight As Long
    Dim shapeWidth As Long

'******* ******* ******* SHAPE 01

 ' Set variables so they are not equal to Nothing
    Set worksheet01 = Workbooks(WorkbookNameNew).Worksheets("WorksheetName")

    ' Identify the name of the existing shape
    PictureName01 = "WorkbookNewNamedPicture01"

    Set shape01 = worksheet01.Shapes(PictureName01)

    Set worksheet02 = Workbooks(WorkbookNameOld).Worksheets("WorksheetName")

    ' Identify the name of the existing shape
    PictureName02 = "WorkbookOldNamedPicture01"

    Set shape02 = worksheet02.Shapes(PictureName02)

    Set shape03 = shape01

' Capture properties of exisitng picture such as location and size
' Measurements in points must be converted from desired inches. Use http://www.thecalculatorsite.com/conversions/length/points-to-inches.php

    shapeTop = shape01.Top
    shapeLeft = shape01.Left
    shapeHeight = shape01.Height
    shapeWidth = shape01.Width

' Copy first shape in Workbook B
    worksheet02.Shapes(PictureName02).Copy

' Delete existing shape in Workbook A
    worksheet01.Shapes(PictureName01).Delete

' Paste the copied shape into Workbook A
    worksheet01.Paste

' Identify and select the most recently added shape in Workbook A
    Set shape03 = worksheet01.Shapes(worksheet01.Shapes.Count)

' Reapply shape properties to the recently added shape in Workbook A
    shape03.Top = shapeTop
    shape03.Left = shapeLeft
    shape03.Height = shapeHeight
    shape03.Width = shapeWidth

' Apply expected name to the recently added shape in Workbook A
    shape03.Name = "WorkbookNewNamedPicture01"

'******* ******* ******* SHAPE 02

'******* ******* ******* SHAPE 03

'******* ******* ******* SHAPE 04

'******* ******* ******* SHAPE 05

'******* ******* ******* SHAPE 06

' User Feedback of successful transfer and name of Workbook B
    MsgBox ("TRANSFER COMPLETED FROM:" & " " & WorkbookNameOld)

' Re-protect specifc worksheet in Workbook A that received new shapes from Workbook B
    Sheet05.Protect Password:="MyPassword"

' Restore the settings that were changed temporarily to speed up the transfer process
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

Exit Sub

' Finish Error Handling
    Errorcatch:
    MsgBox Err.Description

End Sub

Answer 1

正如评论中所指出的那样，你在Set shape03 = worksheet01.Shapes(shape03.Shapes.Count)这行上出错了

您无法计算形状对象。相反，使用：

Set shape03 = worksheet01.Shapes(worksheet01.Shapes.Count)