Почему Excel vba копирует в буфер обмена непоследовательно?

Question

У меня есть макрос первенствовать, который делает две очень простые вещи:

1. отображает текущую дату и время в маленьком окне.
2. Он копирует экран как текстовую строку для вставки в другие приложения по мере необходимости.

Ячейка, которая отображается, имеет следующую формулу в нем:

=TEXT(NOW(),"yyyy.MM.dd hh:mm:ss") 

Каждые 5 секунд, макро обновляет время и тиков.

Моя проблема в том, что когда я копирую время из ячейки, я не получаю содержимое, вставленное в буфер обмена. Иногда содержимое ячеек помещается в буфер обмена. Я не могу понять, почему это работает иногда, а не другие, поскольку не так много происходит. Он должен всегда работать.

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

Весь код находится в одном модуле.

 Dim stopSwitch As Integer 
    Dim NextTick 
    Sub myupdate() 
     If ActiveCell.Address = "$B$1" Then 
      growWindow ' resize window beyond just clock display 
      stopTime ' 
      Exit Sub ' stop updating 
     End If 

     Range("a1").Select 
     Calculate 

     DoEvents 
     If ActiveWorkbook.Name = "calendar clock.xlsb" Then shrinkWindow 
     NextTick = Now + TimeValue("00:00:05") ' give me 5 seconds to copy/paste 
     Application.OnTime NextTick, "myupdate" 
     ThisWorkbook.Save ' futile attempt to prevent save dialog 
    End Sub 

    Sub auto_open() 
    ' to stop clock, tap right arrow to select cell b1 when workbook is active 
    Range("a1").Select 
    myupdate 

    End Sub 

    Sub growWindow() 
     Application.Width = 768 
     Application.Height = 621.75 
     ThisWorkbook.Save 
    End Sub 

    Sub shrinkWindow() 
     ' strip decorations so window is as small as possible 
     Application.DisplayFormulaBar = False 
     ActiveWindow.DisplayGridlines = False 
     ActiveWindow.DisplayHeadings = False 

     ' move window to second monitor and size to single cell display 
     Application.WindowState = xlNormal 
     Application.Top = 0 
     Application.Left = -720 
     Application.Width = 174 
     Application.Height = 127 
     ActiveWindow.WindowState = xlMaximized 
    End Sub 

    Sub stopTime() ' called when workbook is closed 
     On Error Resume Next 
     Application.OnTime NextTick, "myupdate", schedule:=False 
     Range("b1").Select 
    End Sub 

    Sub copyTime() 
     Range("a1").Copy ' copy time 
     Range("f5").PasteSpecial xlPasteValues ' strip formatting 
     Range("f5").Copy ' copy time as text 
     DoEvents ' hack to attempt to make copy work consistently 
    End Sub 

Приведенный выше код меняет окно и обновляет часы каждые 5 секунд.

Чтобы скопировать часы в виде текста в буфер обмена, я следующий код в книге

Private Sub Workbook_Activate() 
    Application.OnKey "^c", "module1.copyTime" 
End Sub 

Private Sub Workbook_Deactivate() 
    Application.OnKey "^c" 
End Sub 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    ' turn off auto update 
    Module1.stopTime 

    ' resize window so if I open another spreadsheet, it's a reasonable size 
    Application.WindowState = xlNormal 
    Application.Width = 768 
    Application.Height = 621.75 
    Application.OnKey "^c" 

    ThisWorkbook.Save ' try to prevent save dialog at close 
End Sub 

Я изменил функцию copyTime для проверки^C видно, выбрав неформатированный ячейку, и я могу видеть что данные последовательно идут в ячейку, поэтому я знаю, что моя проблема связана не с диапазоном («a1»). Скопируйте шаг в режиме копирования или в pastespecial в ячейку f5.

Это оставляет диапазон («a5»). Копировать команду как плохой актер, когда копия терпит неудачу, что является странным. Это похоже на то, что копия работает до тех пор, пока данные хранятся внутри электронной таблицы, но не удается обновить внешний буфер обмена последовательно.

Это наблюдение заставило меня попробовать настроить application.cutcopymode на xlcopy, true и false, чтобы увидеть, помогло ли это. Единственный эффект, который я видел при попытке всех настроек, заключается в том, видел ли я f5, выделенный с помощью выделения или нет - ни один из параметров не заставил копию во внешнем буфере обмена.

Я попытался дождаться отметки часов перед копированием, чтобы увидеть, что что-то очищало буфер обмена после копии, если пришло время обновлять часы. Это помогло несколько, но, опять же, не последовательно.

Так почему же копия не удалась всегда обновить буфер обмена? И почему это не работает, когда это не так и происходит, когда это происходит? Еще лучше, как я могу изменить этот код, чтобы он всегда экспортировался во внешний буфер?

Answer 1

Попробуйте использовать этот метод, он всегда надежен для меня

Dim TimeInClip As MSForms.DataObject 
Set TimeInClip = New MSForms.DataObject 
TimeInClip.SetText Range("A1").Value 
TimeInClip.PutInClipboard 

Answer 2

Попробуйте

Sub copyTime() 
    Range("a1").Copy ' copy time 
    Range("f5").PasteSpecial xlPasteValues ' strip formatting 
    Application.CutCopyMode = False ' Clear Excel clipboard 
    Range("f5").Copy ' copy time as text 
    DoEvents ' hack to attempt to make copy work consistently 
End Sub 

Вы сказали, что вы пытались Application.CutCopyMode, но вы пробовали это таким образом?
Это только заставляет приложение очищать буфер обмена перед копированием чего-то другого, который затем должен правильно копироваться в новый буфер обмена.