VBA: вставка из буфера обмена ненадежна - PullRequest
Новая
       25

VBA: вставка из буфера обмена ненадежна

0 голосов
/ 05 марта 2020

Я пытаюсь скопировать диапазон ячеек из Excel и вставить его на слайд презентации PowerPoint (обе версии 2016) с оригинальным форматированием.

Я пытался 

Allg.Copy
mySlide2.Shapes.PasteSpecial DataType:=0
myPresentation.Slides(2).Shapes(3).Name = "AllgShape"

и это работает большую часть времени, но не всегда. Время от времени возникает следующая ошибка времени выполнения:

'- 2147188160 (80048240)': Shapes.PasteSpecial: Неверный запрос. Буфер обмена пуст или содержит данные, которые нельзя вставить сюда

, потому что (я думаю) буфер не заполнен во времени. Поэтому я попытался повторить процесс копирования и вставки, если произошла ошибка: 

ALLGCOPY:
  Allg.Copy
  On Error GoTo ALLGCOPY:
  mySlide2.Shapes.PasteSpecial DataType:=0
  myPresentation.Slides(2).Shapes(3).Name = "AllgShape"

Кажется, что обработчик ошибок не совсем то, что я думаю, потому что иногда он просто вставляет одну и ту же форму 2 раза при запуске этого кода.

Затем я попытался 

Allg.Copy
PowerPointApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
myPresentation.Slides(2).Shapes(3).Name = "AllgShape"

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

, поэтому я добавлен таймер после вставки 

Public Sub Warten(ByVal MilliSekunden As Double)
   Dim i    As Double
   Dim ENDE As Double

   ENDE = Timer + (MilliSekunden / 1000)

   Do While i < ENDE
      DoEvents
      i = Timer
   Loop
End Sub

Но это ненадежно, потому что иногда достаточно 100 мс, но иногда даже 2000 мс недостаточно, и я хочу, чтобы макрос работал на большинстве (также старых) машин.

Желательно, чтобы я работал с обработчиком ошибок, а не с таймером, так как он ненадежен и зависит от загрузки процессора.

Может кто-нибудь сказать мне, почему код с обработчиком ошибок не работает и иногда вставляет одну и ту же форму 2 раза?

РЕДАКТИРОВАТЬ: очевидно мое понимание того, как обработчик ошибок работает недостаточно. Можно решить мою проблему с использованием соответствующего обработчика ошибок.

Спасибо

Ответы [ 2 ]

0 голосов
/ 06 марта 2020

Ваша идея ловушки ошибок - правильный путь. Вот как повторить время ожидания, пока ошибка больше не генерируется: 

    Allg.Copy
TryPaste:
    On Error GoTo TooFast
    mySlide2.Shapes.PasteSpecial DataType:=0
    On Error GoTo 0
    myPresentation.Slides(2).Shapes(3).Name = "AllgShape"
    Exit Sub

TooFast:
  Warten
  Resume TryPaste
End Sub
0 голосов
/ 06 марта 2020

Вопросы, требующие ответов: «Как мне ждать, пока в буфере обмена не появятся данные?» и «Как узнать, когда вставка завершена». Для первого вопроса, основанного на этом ответе среди прочего, вы можете сделать что-то вроде этого: 

Option Explicit

Public Sub PasteSomeData()
   Dim i As Integer

   ClearClipboard
   Allg.Copy

   Do While isClipboardEmpty() And i < 5
      i = i + 1
      Application.Wait Now + TimeValue("00:00:01")
   Loop

   If Not isClipboardEmpty() Then
      mySlide2.Shapes.PasteSpecial DataType:=0
      myPresentation.Slides(2).Shapes(3).Name = "AllgShape"
   End If
End Sub

Поскольку мы выполняем цикл до тех пор, пока в буфере обмена не будут данные, нам нужно предоставить механизм предотвратить бесконечность l oop. Я решил попробовать 5 раз с 1-секундной паузой между каждой попыткой. Отрегулируйте эти значения по мере необходимости. В модуле у меня был следующий код: 

Option Explicit

Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Public Declare PtrSafe Function CountClipboardFormats Lib "user32" () As Long

Public Function ClearClipboard()
   OpenClipboard 0&

   EmptyClipboard

   CloseClipboard
End Function

Public Function isClipboardEmpty() As Boolean
    OpenClipboard 0&

    isClipboardEmpty = (CountClipboardFormats() = 0)

    CloseClipboard
End Function

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

...