Скопируйте лист из одной книги в другую и измените все ссылки на элементы ActiveX, фигуры и диаграммы.

Вопрос или проблема

Option Explicit
Option Compare Text

Sub Copy_Sheet_to_another_Workbook()           'Предполагает, что этот код находится в Workbook1 (ThisWorkbook)
    
    Dim srcWs As Worksheet
    Dim dstWb As Workbook
    Dim dstWs As Worksheet
    Dim shp As Shape
    Dim srcWbName As String
    Dim dstWbName As String
    
    With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
    End With
    
    Set srcWs = ThisWorkbook.Sheets("Board")                             'название листа для копирования
    Set dstWb = Workbooks.Open("C:\Users\xxx\Desktop\Workbook2.xlsb")    'целевой Workbook
    srcWs.Copy Before:=dstWb.Sheets(1)
    Set dstWs = dstWb.Sheets(2)
    
    srcWbName = ThisWorkbook.name
    dstWbName = dstWb.name
      
'Обновление ссылок VBA на макросы/подпрограммы в фигурах с назначенными макросами
   For Each shp In dstWs.Shapes
        If shp.OnAction <> "" Then
            If InStr(1, shp.OnAction, srcWbName, vbTextCompare) > 0 Then
                shp.OnAction = Replace(shp.OnAction, srcWbName, dstWbName)
            End If
        End If
    Next shp

'Обновление фигур с ссылками на ячейки в формуле
    For Each shp In dstWs.Shapes
        If shp.Formula <> "" Then
            If InStr(1, shp.Formula, srcWbName, vbTextCompare) > 0 Then
                shp.Formula = Replace(shp.Formula, srcWbName & "!", dstWbName & "!")
            End If
        End If
    Next shp

'Обновление ссылок на диаграммы
    For Each chartObj In dstWs.ChartObjects
        With chartObj.Chart
            Dim srs As Series
            For Each srs In .SeriesCollection
                If InStr(1, srs.Formula, srcWbName, vbTextCompare) > 0 Then
                    srs.Formula = Replace(srs.Formula, srcWbName & "!", dstWbName & "!")
                End If
            Next srs
        End With
    Next chartObj

    dstWb.Activate
    With Application
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
      .EnableEvents = True
      .DisplayAlerts = True
    End With
    
End Sub

Ответ или решение

Копирование листа из одной книги в другую и модификация всех ссылок, включая ActiveX элементы, графики и диаграммы, может стать настоящим вызовом. Ваша задача, как разработчика, заключается не только в реализации копирования, но и в тонкой подстройке ссылок, чтобы они корректно работали в новой книге. Для справки, ниже представлен детализированный код, который поможет в решении данной проблемы, а также объяснение, как устранить ошибки и оптимизировать вашу работу.

Решение задачи

Option Explicit
Option Compare Text

Sub Copy_Sheet_to_another_Workbook()          
    Dim srcWs As Worksheet
    Dim dstWb As Workbook
    Dim dstWs As Worksheet
    Dim shp As Shape
    Dim chartObj As ChartObject
    Dim srs As Series
    Dim srcWbName As String
    Dim dstWbName As String

    ' Отключаем обновление экрана и вычисления для ускорения
    With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
    End With

    ' Указываем лист для копирования
    Set srcWs = ThisWorkbook.Sheets("Board")
    ' Открываем книгу назначения
    Set dstWb = Workbooks.Open("C:\Users\xxx\Desktop\Workbook2.xlsb")
    srcWs.Copy Before:=dstWb.Sheets(1)
    Set dstWs = dstWb.Sheets(1)

    srcWbName = ThisWorkbook.Name
    dstWbName = dstWb.Name

    ' Обновление ссылок на макросы для ActiveX и фигур
    UpdateActiveXControls dstWs, srcWbName, dstWbName
    UpdateShapes dstWs, srcWbName, dstWbName
    UpdateCharts dstWs, srcWbName, dstWbName

    ' Завершение работы
    With Application
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
      .EnableEvents = True
      .DisplayAlerts = True
    End With

End Sub

Sub UpdateActiveXControls(ws As Worksheet, srcWbName As String, dstWbName As String)
    Dim ctl As Object
    For Each ctl In ws.OLEObjects
        If InStr(1, ctl.Object.OnAction, srcWbName, vbTextCompare) > 0 Then
            ctl.Object.OnAction = Replace(ctl.Object.OnAction, srcWbName, dstWbName)
        End If
    Next ctl
End Sub

Sub UpdateShapes(ws As Worksheet, srcWbName As String, dstWbName As String)
    Dim shp As Shape
    For Each shp In ws.Shapes
        If shp.OnAction <> "" Then
            If InStr(1, shp.OnAction, srcWbName, vbTextCompare) > 0 Then
                shp.OnAction = Replace(shp.OnAction, srcWbName, dstWbName)
            End If
        End If

        ' Проверка и обновление формул
        If shp.Type = msoAutoShape Or shp.Type = msoShape Then
            If InStr(1, shp.Formula, srcWbName, vbTextCompare) > 0 Then
                shp.Formula = Replace(shp.Formula, srcWbName & "!", dstWbName & "!")
            End If
        End If
    Next shp
End Sub

Sub UpdateCharts(ws As Worksheet, srcWbName As String, dstWbName As String)
    Dim chartObj As ChartObject
    Dim srs As Series
    For Each chartObj In ws.ChartObjects
        For Each srs In chartObj.Chart.SeriesCollection
            If InStr(1, srs.Formula, srcWbName, vbTextCompare) > 0 Then
                srs.Formula = Replace(srs.Formula, srcWbName & "!", dstWbName & "!")
            End If
        Next srs
    Next chartObj
End Sub

Подробности реализации

1. Копирование листа: Мы используем srcWs.Copy для создания копии листа и помещаем его перед первым листом в целевой книге.

2. Обновление ActiveX управляемых элементов: Метод UpdateActiveXControls проходит по всем элементам управления ActiveX на листе и обновляет их свойства OnAction, чтобы они указывали на соответствующую книгу.

3. Обновление фигур: Метод UpdateShapes проверяет каждую фигуру на наличие свойств OnAction и Formula. Убедитесь, что двойная проверка происходит для типов msoAutoShape и msoShape, поскольку для некоторых фигур, как округлые прямоугольники и октогоны, ваша ошибка могла быть связана с неправильным обращением к свойству Formula.

4. Обновление диаграмм: Метод UpdateCharts берет каждую диаграмму на листе и проходит по ее коллекции серий, обновляя формулы.

Заключение

Правильное управление ссылками и обновление их после копирования листа обеспечит корректную работу всех элементов управления и диаграмм в новой книге. Правильно организованный код также улучшит читаемость и управление. Убедитесь, что ваши пути и имена файлы соответствуют действительности, чтобы избежать ошибок при выполнении.