VBA конвертировать встроенный лист Excel в таблицу слов в файл слов - PullRequest
Новая
       76

VBA конвертировать встроенный лист Excel в таблицу слов в файл слов

1 голос
/ 10 июня 2019

Мне нужно преобразовать вложенный объект листа Excel в таблицу слов в файле слов, который я сейчас использую, чтобы открыть встроенный объект листа Excel, выбрать содержимое и вставить в слово.Может ли быть лучший способ упростить это действие?

Я пытаюсь создать mirco, но .OLEformat keep error и говорит, что к этому элементу нельзя получить доступ по горизонтальной линии. 

Sub ConvertXLObjs()
Application.WindowState = wdWindowStateMinimize
Dim i As Long, j As Long, k As Long, Rng As Range, bDel As Boolean
Dim objOLE As Word.OLEFormat, objXL As Object
With ActiveDocument
For i = .InlineShapes.Count To 1 Step -1
With .InlineShapes(i)
  If Not .OLEFormat Is Nothing Then
    If Split(.OLEFormat.ClassType, ".")(0) = "Excel" Then
      Set Rng = .Range
      Set objOLE = .OLEFormat
      objOLE.Activate
      Set objXL = objOLE.Object
      With objXL.ActiveSheet
        .Range("$A$1:" & _
        .Cells.SpecialCells(11).Address).Copy ' 11 = xlCellTypeLastCell
      End With
      objXL.Application.Undo
      .Delete
      With Rng
        .Characters.First.PasteAndFormat wdTableInsertAsRows
        .MoveEnd wdParagraph, 2
        With .Tables(1)
          .AllowAutoFit = False
          .BottomPadding = 0
          .LeftPadding = 0
          .RightPadding = 0
          .TopPadding = 0
          .Rows.AllowBreakAcrossPages = False
          .Rows.HeightRule = wdRowHeightExactly
          If .Uniform = True Then
            For j = .Columns.Count To 1 Step -1
              bDel = True
              For k = 1 To .Columns(j).Cells.Count
                If Len(.Columns(j).Cells(k).Range.Text) > 2 Then
                  bDel = False
                  Exit For
                End If
              Next
              If bDel = True Then
                .Columns(j).Delete
              Else
                Exit For
              End If
            Next
          End If
        End With
      End With
    End If
  End If
End With
Next
End With
Set objXL = Nothing: Set objXL = Nothing: Set Rng = Nothing
Application.WindowState = wdWindowStateNormal
MsgBox "Finished processing!"
End Sub

theкод относится к https://social.msdn.microsoft.com/Forums/office/en-US/5955da06-725d-45f2-aa1b-5eb37c0646c6/how-to-convert-all-embeded-excel-sheets-in-word-into-words-tables?forum=worddev

Пример: Example

...