替代 Microsoft Word 中的 GetFromClipboard

Question

我需要 Microsoft Word 365 (Windows 10) 中

GetFromClipboard

的替代方案。

我的代码使用

GetFromClipboard

这样的东西：

Public var1
Dim MyData As DataObject
Set MyData = New DataObject
Dim var1 As String  

' extra code that locates text and selects it’
Selection.Copy
MyData.GetFromClipboard
var1 = MyData.GetText(1)

我能够读取 var1 并根据存储在那里的内容执行嵌套宏，我还可以粘贴内容或使用 TypeText 将内容插入到文档中。

这个方法行之有效了好几年。现在我的一些客户端用户收到一致的错误消息：

DataObject:GetFromClipboard OpenClipboard 失败。

起初，它可能会读取前 25 次出现的代码，但会在第 26 次停止。有一段时间，用户可以重新启动宏，代码行将起作用，整个过程将运行。然后需要进行2-3次尝试。每次出现错误消息时，它都会停在

GetFromClipboard

行的不同实例上。现在宏拒绝传递第一行

GetFromClipboard

，并抛出错误消息。

公司中的一台计算机可以运行这些宏并且不会给出错误。办公室里的每个人都必须坐在这一台计算机前来运行这些宏。它使用相同的Normal.dotm，具有相同的操作系统。

我需要一个替代方案，其关键特征是存储的变量必须在嵌套宏或调用宏中可用。我尝试的大多数选项只要该宏正在运行就会存储变量的内容。它不会在嵌套或调用的宏中记住它。

我发现一个帖子说要使用

Static

（有一个清晰的例子）。除非我编码错误，否则它不起作用。

如何复制文本，将文本存储在变量中，并在主宏调用的其他宏中访问该变量的内容？

我尝试了

Static

、

PutInClipboard

，以及其他几个在 Excel 中有效的选项，但在 Word 中无效。

Answer 1

• 剪贴板不是一个可靠的解决方案。用户的操作或其他软件可能会破坏剪贴板中的内容。

• 我建议将该值存储在 Windows 注册表中而不是剪贴板中。优点是重启后仍然可以访问。

Option Explicit

Sub WriteRegistry()
    Dim KeyName As String
    Dim StrValue As String
    Const APP_NAME = "MyApp" ' modify as needed
    Const SECTION = "Word"
    KeyName = "WordVar"
    StrValue = "**This is a test string.**"
    SaveSetting APP_NAME, SECTION, KeyName, StrValue
    MsgBox "Text successfully stored in the registry.", vbInformation
End Sub

Sub ReadRegistry()
    Dim KeyName As String
    Dim StrValue As String
    Const APP_NAME = "MyApp"
    Const SECTION = "Word"
    KeyName = "WordVar"
    StrValue = GetSetting(APP_NAME, SECTION, KeyName)
    MsgBox "Retrieved Text: " & StrValue, vbInformation
End Sub

Sub RemoveRegistry()
    Const APP_NAME = "MyApp"
    Const SECTION = "Word"
    DeleteSetting APP_NAME, SECTION
    MsgBox "Remove it from the registry.", vbInformation
End Sub

微软文档：

保存设置语句

获取设置功能

删除设置语句

Answer 2

此函数使用 Windows API 访问剪贴板的内容并将其作为字符串返回（此函数仅在内容可以表示为字符串时才有效 - 它会检查是否是这种情况，所以即使内容不是字符串不会有错误，它只会返回一个空字符串）

API 声明适用于 32 位和 64 位版本的 Office。

编辑：仅适用于 VBA 7（对于早期版本，必须调整声明 - 如果代码需要在 VBA 7 和更早版本上工作，可以通过条件编译来完成）

Option Explicit

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal uFormat As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal uFormat As Long) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As LongPtr

Private Enum ClipboardFormats
    CF_TEXT = 1&
    CF_OEMTEXT = 7&
    CF_UNICODETEXT = 13&
End Enum

Public Function getText() As String
    Dim hClip As LongPtr
    Dim pLock As LongPtr
    Dim uniText As String
    Dim size As Long
    
    If OpenClipboard(0&) = 0 Then Exit Function
    If IsClipboardFormatAvailable(ClipboardFormats.CF_UNICODETEXT) <> 0 Then
        hClip = GetClipboardData(ClipboardFormats.CF_UNICODETEXT)
        If Not IsEmpty(hClip) Then
            pLock = GlobalLock(hClip)
            If pLock Then
                size = GlobalSize(hClip)
                uniText = String$(size \ 2& - 1&, vbNullChar)
                lstrcpy StrPtr(uniText), pLock
                GlobalUnlock hClip
            End If
            getText = Replace(uniText, vbNullChar, "")
        End If
    End If
    CloseClipboard
End Function

您可以按如下方式使用它：

Sub main()
    var1 = getText()
End Sub