我设置了一些模板,用户可以从其他地方复制并粘贴到文档中,并且粘贴的文本将始终默认为使用下面的脚本的正文文本,除非他们想要粘贴表格,否则该脚本效果很好。我还删除了功能区中的粘贴选项以及许多其他选项来控制用户可以更改的内容。
粘贴表格时,他们希望保留表格的格式(理想情况下使用目标格式,但一次一步) 根据我的研究,我发现不可能知道复制的文本是否是表格,因为剪贴板不会将特定信息存储在word中(除非自从我读过帖子以来这已经发生了变化)并且我没有找到任何东西这表明粘贴事件具有任何将其标识为表格的内容,除非首先将其粘贴到空白文档中。我想知道只要源显然仍然是打开的,是否可以使用VBA以某种方式识别它是否是源中的表?
到目前为止,我的研究中没有任何内容表明可以识别正在复制/粘贴的表格,但我想无论如何我都会问
Dim newText As String
Dim clipboardText As String
Selection.TypeText vbCrLf
Selection.Style = "Body Text"
clipboardText = GetClipboardText()
newText = vbCrLf & clipboardText
' Applying formatting to the pasted text
With Selection
.Font.Bold = False
.Font.Size = 11
.Font.Color = wdColorBlack
.Font.Name = "Calibri"
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.ParagraphFormat.SpaceAfter = 1
.Range.HighlightColorIndex = wdNoHighlight
End With
' Pasting text at the current selection
Selection.TypeText newText
你没有回答我的澄清问题,过了一段时间......
因此,下一个解决方案检查剪贴板中是否是 Excel 表格(的一部分)(
listObject
)。它可以很容易地进行调整以检查是否所有表格都已复制,表格DataBodyRange
或其他内容(如果逻辑/明确定义)...
该代码设计为在 WBA7 64 位版本中工作。它也可以适应32位版本。
Option Explicit
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
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 lngFormat As Long) As LongPtr 'modificat din Long in Any
Private Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardFormatNameA Lib "user32" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Sub testIsTableInClipboard() 'place a table (part) in memory and TEST IF CLIPBOARD CONTAINS a table (part)
Debug.Print IsTableInClipboard
End Sub 'then copy something else (text, an ordinary range etc.) and test it again...
Function IsTableInClipboard() As Boolean 'it checks if an EXCEL TABLE (
Dim dataHwnd As LongPtr 'pointer to clipboard data
Dim intOffset As Integer 'for parsing clipboard data
Dim strClipData As String 'clipboard data
Dim strGetClipRange As String 'return range address (wb and ws)
Dim rngFormatID As Long 'id number for link format (Range)
Dim strWorkbookName As String 'the range workbook to be used to set Excel Session!
Const intMaxSize As Integer = 256 'limit for r1c1 to a1 conversion
rngFormatID = getRangeFormatID("Link") 'extracting the id number for "link" format (Range)
If OpenClipboard(0&) = 0 Then GoTo safeExit 'go to code end to unlock and close clipboard and exit
dataHwnd = GetClipboardData(rngFormatID) 'pointer to clipboard data
If dataHwnd = CLngPtr(0) Then GoTo safeExit 'could not allocate memory
dataHwnd = GlobalLock(dataHwnd) 'lock clipboard memory, so we can reference
If IsNull(dataHwnd) Then GoTo safeExit 'if could not lock clipboard memory
intOffset = 0 'start parsing data
strClipData = Space$(intMaxSize) 'initialize string
Call lstrcpy(strClipData, dataHwnd + intOffset) 'copy pointer to string
If strClipData = Space$(intMaxSize) Then GoTo safeExit 'not excel range on clipboard
strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1) 'trim null character
If strClipData <> "Excel" Then GoTo safeExit 'not excel range on clipboard
intOffset = intOffset + 1 + Len(strClipData) 'next offset
strClipData = Space$(intMaxSize) 'reset string
Call lstrcpy(strClipData, dataHwnd + intOffset) 'book and sheet next to it
strWorkbookName = VBA.Replace(Split(strClipData, "]")(0), "[", "") 'the workbook name where from the range belongs!
'Debug.Print strWorkbookName: Stop
strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1) 'trim null character
strGetClipRange = "'" & strClipData & "'!" 'get workbookbook and sheet
intOffset = intOffset + 1 + Len(strClipData) 'next offset
strClipData = Space$(intMaxSize) 'initialize string
Call lstrcpy(strClipData, dataHwnd + intOffset) 'range next
strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1) 'trim null character
strGetClipRange = strGetClipRange & strClipData 'add range to extracted string (xlR1C1 style)
'Dim exApp As Excel.Application, ClipBRange As Excel.Range, tbl As Excel.ListObject 'i tneeds reference to Excel...
Dim exApp As Object, ClipBRange As Object, tbl As Object
Set exApp = GetObject(strWorkbookName).Application
strGetClipRange = exApp.ConvertFormula(strGetClipRange, xlR1C1, xlA1) 'convert the range style
Set ClipBRange = exApp.Range(strGetClipRange) 'range in a1 style
Set tbl = ClipBRange.ListObject 'check if ClipBRange is part of an Excel table
If Not tbl Is Nothing Then 'if tbl is not nothing
Call GlobalUnlock(dataHwnd) 'unlock clipboard memory
Call CloseClipboard 'close ClipBoard
Set exApp = Nothing 'release Excel app from memory
IsTableInClipboard = True: Exit Function 'make it True and exit function
End If
safeExit:
Call GlobalUnlock(dataHwnd) 'unlock clipboard memory
Call CloseClipboard 'close ClipBoard
End Function
Function getRangeFormatID(strFormatName As String) As Long 'it looks that for a range the ID is not a constant...
Dim FormatId As Long, retFormat As String, formatLength As Integer
If OpenClipboard(0&) = 0 Then Exit Function 'could not open clipboard
formatLength = Len(strFormatName) + 30 'we only need a couple extra to make sure there isn't more
FormatId = 0 'initialized at zero
Do
retFormat = Space(formatLength) 'initialize string
GetClipboardFormatNameA FormatId, retFormat, formatLength 'get the id name
retFormat = Trim(retFormat) 'trim spaces
If retFormat <> "" Then 'if some string remained
retFormat = Left(retFormat, Len(retFormat) - 1) 'get rid of terminal character
If retFormat = strFormatName Then 'if it matches strFormatName
getRangeFormatID = FormatId 'return the correspondent id number
Exit Do 'exit Loop
End If
End If
FormatId = EnumClipboardFormats(FormatId) 'get the next id number
Loop Until FormatId = 0 'exit the loop after last id number
Call CloseClipboard 'close clipboard
End Function
testIsTableInClipboard
测试子进行操作。它将返回True
。然后,复制其他内容(字符串、文件、普通范围等)并再次运行。这次又回来了False
每行代码都以易于理解的方式进行注释(我认为)。如果有些事情不够清楚,请随时要求澄清。
请在测试后发送一些反馈。