Вставить как основной текст в документ Word, если это не таблица

Вы не ответили на мой уточняющий вопрос, спустя некоторое время...

Итак, следующее решение проверяет, находится ли в буфере обмена (часть) таблицы Excel (listObject). Его можно легко адаптировать для проверки того, вся ли таблица скопирована, таблица DataBodyRange или что-то еще, если она логически/четко определена...

Код предназначен для работы в 64-битной версии VBA7. Его можно адаптировать и для работы в 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...

'or paste the clipboard content using Excel table format:
Sub testPasteExcelTable() 'paste the table formatted as Excel table:
    If IsTableInClipboard Then
        Selection.PasteExcelTable False, False, False 'Pastes and formats a Microsoft Excel table.
        'expression. PasteExcelTable( _LinkedToExcel_ , _WordFormatting_ , _RTF_ ) 'method's parameters
    End If
End Sub

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

2. Поместите таблицу Excel или ее часть в буфер обмена, а затем поиграйте с подпрограммой тестирования testIsTableInClipboard. Оно вернется True. Затем скопируйте что-нибудь еще (строки, файлы, обычный диапазон и т. д.) и запустите его снова. На этот раз оно вернется False

Каждая строка кода прокомментирована таким образом, чтобы ее было легко понять (я думаю). Если что-то не совсем понятно, не стесняйтесь обращаться за разъяснениями.

Пожалуйста, оставьте отзыв после тестирования.

Выполнение чего-то подобного не займет много времени, и вы, возможно, сможете выполнить частичное или все форматирование таблицы во временном документе, возможно (не проверяли), вставив его в реальный документ с помощью .FormattedText.

Но, возможно, слишком медленно для тех случаев, когда они не вставляют таблицу.

Function IncludesATable() As Boolean
Dim d As Word.Document
Application.ScreenUpdating = False
On Error Goto problem
With Application.Documents.Add(Visible:False)
  .Content.Paste
  IncludesATable = (.Content.Tables.Count > 0)
  .Close SaveChanges:=wdDoNotSaveChanges
End With

problem:
Application.ScreenUpdating = True
End Function

' Test routine
Sub TableNoTable()
If IncludesATable Then
  Selection.TypeText "There's a table."
Else
  Selection.TypeText "There isn't a table."
End If
End Sub