为什么Excel vba不一致地复制到剪贴板？

Question

我有一个excel宏,它做了两件非常简单的事情:

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,我可以看到数据一直进入单元格,所以我知道我的问题不在于Range("a1").复制时的复制步骤或者特殊于细胞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