Проблема с VBA Excel при вставке диаграмм

Я впервые пишу о помощи, поэтому извините, если есть какие-то условные ошибки, но я ищу решение своей проблемы больше месяца и нигде не мог его найти.

У меня есть код, который хранится на общем диске для моей команды. Они используют его, нажимая разные кнопки на ленте для запуска сценариев VBA, поэтому все ребята используют один и тот же макрос. Кроме того, большинство их локальных вариаций среды одинаковы (некоторые из них добавили локальные клавиатуры, но их удаление не решило проблему). Одна и та же подпрограмма запускается каждый раз в скрипте 13 раз (13 итераций для копирования 13 диаграмм с разных листов, чтобы собрать их в один).

Это суб:

Sub Movechart(TabName, ChartName, PasteRange)


Sheets(TabName).Activate

'this is to walk-over part of errors that were caused by not executing line above
If ActiveSheet.Name <> TabName Then
    Sheets(TabName).Select
End If

Range("a1").Select
ActiveSheet.Shapes(ChartName).Copy
        
Sheets("MAIL").Select
Range(PasteRange).Select
ActiveSheet.Paste
ActiveSheet.Shapes(ChartName).IncrementTop 1
ActiveSheet.Shapes(ChartName).IncrementLeft 1

Application.CutCopyMode = False
End Sub

На нескольких компьютерах это иногда вызывало ошибку при выполнении этого подпрограммы. Некоторые ребята сталкиваются с проблемой только один раз из 13 итераций, другие несколько раз, а некоторые никогда. Также я сам сталкиваюсь с той же ошибкой, но не каждый раз при запуске скрипта. Я заметил, что обычно это не дает ошибки, когда я тестирую некоторые изменения, и у меня есть где-нибудь до точки разрыва.

Сам скрипт довольно массивный, модулей немного, но процесс автоматизации занял 1 час вручную.

Выполнение кода останавливается в очереди

ActiveSheet.Paste

Некоторые остановки были вызваны невыполнением линии

Листы(TabName).Активировать

Поэтому я сделал обход видимым в коде. Некоторые из них все еще происходят, что приводит к этой ошибке:

Ошибка выполнения «1004»: сбой метода вставки класса Worksheet

Когда я останавливаю макрос в этом месте и пытаюсь вручную вставить (CTRL+V), он дает мне график из предыдущей итерации, поэтому похоже, что он пропускает исполняемую строку

ActiveSheet.Shapes(ИмяДиаграммы).Копировать

а затем он получил некоторую внутреннюю ошибку мешанины, а не то, что написано в фактической подсказке об ошибке.

Я хочу добавить, что машины довольно мощные, у нас есть 16 ГБ ОЗУ на каждой виртуальной машине. Ошибка начала возникать, когда мы перешли с Win7 -> Win10, до этого скрипт использовался долгое время без проблем.

Я уже пытался использовать только 1 из 4 процессоров, а также отключил историю буфера обмена, что помогло только одному парню :)

Ваша помощь будет оценена по достоинству!


person Miłosz Fox    schedule 30.12.2020    source источник
comment
Любой код, использующий буфер обмена, вероятно, нуждается в некоторых ручных буферах или DoEvents, добавленных туда. Я бы просто добавил Application.Wait(Now + TimeValue("00:00:01")) после строки копирования и после строки вставки и посмотрел, поможет ли это.   -  person dwirony    schedule 30.12.2020
comment
У меня был проект, в котором я переносил (копировал/вставлял) диаграммы из Excel в PowerPoint. По моему опыту, добавление времени ожидания, как было предложено, не решило проблему. Мое решение состояло в том, чтобы проверять после каждой итерации, присутствует ли диаграмма и является ли она подходящей диаграммой. Если нет, то удалите весь слайд и повторите итерацию, пока не было. Таким образом, вы можете проверять на каждой итерации, правильно ли перенесена диаграмма, и при необходимости повторять шаг. Однако мой проект был межприкладным, от Excel до PowerPoint.   -  person Lorne    schedule 30.12.2020
comment
Я использовал этот подход для успешного устранения ошибок вставки в Excel - заголовок ="shapes копировать и вставить проблему синхронизации excel vba"> stackoverflow.com/questions/60579662/   -  person Tim Williams    schedule 30.12.2020


Ответы (1)


Большое спасибо за ваш ответ. Кажется, что объединение цикла, повторяющего копирование-вставку и

DoEvents

помогло. Это рабочий код сейчас:

Sub Movechart(TabName, ChartName, PasteRange)
Dim Check As Integer

Check = 0
Do While Check < 20
    Sheets(TabName).Activate
    
    If ActiveSheet.Name <> TabName Then
        Sheets(TabName).Select
    End If
    
    Range("a1").Select
    ActiveSheet.Shapes(ChartName).Copy
            
    Sheets("MAIL").Select
    Range(PasteRange).Select
    On Error Resume Next
        ActiveSheet.Paste
        If Err.Number <> 0 Then
            DoEvents
            Check = Check + 1
            If Check > 19 Then
                MsgBox "Error with pasting charts, pls contact developer"
            End If
        Else
            Check = 20
            Exit Do
        End If
    On Error GoTo 0
Loop

ActiveSheet.Shapes(ChartName).IncrementTop 1
ActiveSheet.Shapes(ChartName).IncrementLeft 1

Application.CutCopyMode = False
End Sub
person Miłosz Fox    schedule 13.01.2021