在Word文档中粘贴为正文,除非它是表格

问题描述 投票:0回答:1

我设置了一些模板,用户可以从其他地方复制并粘贴到文档中,并且粘贴的文本将始终默认为使用下面的脚本的正文文本,除非他们想要粘贴表格,否则该脚本效果很好。我还删除了功能区中的粘贴选项以及许多其他选项来控制用户可以更改的内容。

粘贴表格时,他们希望保留表格的格式(理想情况下使用目标格式,但一次一步) 根据我的研究,我发现不可能知道复制的文本是否是表格,因为剪贴板不会将特定信息存储在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
vba ms-word
1个回答
0
投票

你没有回答我的澄清问题,过了一段时间......

因此,下一个解决方案检查剪贴板中是否是 Excel 表格(的一部分)(

listObject
)。它可以很容易地进行调整以检查是否所有表格都已复制,表格
DataBodyRange
或其他内容(如果逻辑/明确定义)...

该代码设计为在 WBA7 64 位版本中工作。它也可以适应32位版本。

  1. 将下一个代码复制到新的标准模块中:
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
  1. 将 Excel 表格或其中一部分放入剪贴板,然后使用
    testIsTableInClipboard
    测试子进行操作。它将返回
    True
    。然后,复制其他内容(字符串、文件、普通范围等)并再次运行。这次又回来了
    False

每行代码都以易于理解的方式进行注释(我认为)。如果有些事情不够清楚,请随时要求澄清。

请在测试后发送一些反馈。

© www.soinside.com 2019 - 2024. All rights reserved.