none
How to convert all embeded excel sheets in word into word's tables..? RRS feed

  • Question

  • Hi everyone,

    We have many monthly financial reports with embedded excel spread sheets data on different pages..  I understand you can do a cut and past special to convert these data into word tables manually.. However,  we want to automate this process and I think a marco in word might able to do this coz we got many reports to processing everyday..

    Can anyone help me up on this in Marco codes (VBA)... coz I don't know VBA ..?

    Sub TurnSheetToTable()
      Dim myDoc As Object
       Set myDoc = ActiveDocument
       For Each OleShape In ActiveDocument.InlineShapes
          If InStr(1, OleShape.OLEFormat.ProgID, "Excel") And OleShape.OLEFormat.DisplayAsIcon = False Then
         
           Dim myXls As Object
                       
           myXls.Activate
           myXls.Object.worksheets(1).UsedRange.CurrentRegion.Copy
           Selection.PasteExcelTable False, True, False
      
        End If
       Next OleShape
     End Sub

     The program fails at  "myXls.Activate" ....  Please help...thanks..

    Wednesday, November 27, 2013 5:20 AM

Answers

  • IMHO Microsoft has never adequately provided for the activation and de-activation of embedded objects. The de-activation, in particular is poorly supported and requires some counter-intuitive coding. It's little wonder you've run into difficulties. Try something based on:

    Sub ConvertXLObjs()
    Dim i As Long, Rng As Range
    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
              objXL.Worksheets(1).UsedRange.CurrentRegion.Copy
              objXL.Application.Undo
              .Delete
              Rng.PasteAndFormat wdTableInsertAsRows
            End If
          End If
        End With
      Next
    End With
    Set objXL = Nothing: Set objXL = Nothing: Set Rng = Nothing
    End Sub

    Note that, due to scaling issues, the converted objects may not be the same size as they were before conversion and some data may be compromised if the activated object doesn’t display it properly.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    Wednesday, November 27, 2013 10:53 AM
  • OK, the problem is in the use of 'CurrentRegion' (which I simply replicated from the code you posted without thinking about its implications). In Excel, the current region is a range bounded by any combination of blank rows and blank columns. Since your worksheets at start at A1, the 'CurrentRegion' ends at the first non-blank row & column. The following code revision, which references the LastCell cell type, doesn't suffer that flaw:

    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

    You'll see that I've added a fair bit more code, too, to manage as much as possible of the table reformatting in Word. Even so, despite the code referencing .Cells.SpecialCells(xlCellTypeLastCell).Address, extra columns are sometimes included. I've added some code to delete these from the tables but you'll still get some tables that have empty columns off to the right, mostly in tables that have merged cells. You may or may not want to delete those columns, though their presence isn't evident unless you have Word configured to show gridlines and/or formatting marks.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Friday, November 29, 2013 5:34 AM

All replies

  • IMHO Microsoft has never adequately provided for the activation and de-activation of embedded objects. The de-activation, in particular is poorly supported and requires some counter-intuitive coding. It's little wonder you've run into difficulties. Try something based on:

    Sub ConvertXLObjs()
    Dim i As Long, Rng As Range
    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
              objXL.Worksheets(1).UsedRange.CurrentRegion.Copy
              objXL.Application.Undo
              .Delete
              Rng.PasteAndFormat wdTableInsertAsRows
            End If
          End If
        End With
      Next
    End With
    Set objXL = Nothing: Set objXL = Nothing: Set Rng = Nothing
    End Sub

    Note that, due to scaling issues, the converted objects may not be the same size as they were before conversion and some data may be compromised if the activated object doesn’t display it properly.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    Wednesday, November 27, 2013 10:53 AM
  • Hi Pual,

    Thanks your for your wonderful answer and solution...

    I try to run the program you provided to test the outcome.. apparently the headings of the embedded worksheets were converted but all the data or rows within the worksheets were missing... any idea where gone wrong with the script?

    thanks,

    Crispin Lee

    Thursday, November 28, 2013 3:20 AM
  • Without seeing the document, it's hard to say. Did you note my caveat about what can happen if the data don't display properly in the activated workbook?

    It might help to diagnose & resolve if you could upload a sample document (delete/obfuscate anything sensitive) to one of the free file-hosting sites like http://www.4shared.com and post a link here, so I can download it and see what's going on.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Thursday, November 28, 2013 4:23 AM
  • Hi Paul,

    Thanks for offering to help... I tried to provide the link in 4shared but the system prevent me to include the link in the email unless my account is verified... as such would it be possible you send me a reply to my yahoo email address so that I can send you the link or the sample file...?

    I have also included an enhanced version of my original codes based on your input...Let me know how can I improve on codes to solve the problem...

    thanks and regards,

     

    Crispin



    • Edited by Crispin Lee Monday, December 2, 2013 7:59 AM
    Thursday, November 28, 2013 6:25 AM
  • OK, the problem is in the use of 'CurrentRegion' (which I simply replicated from the code you posted without thinking about its implications). In Excel, the current region is a range bounded by any combination of blank rows and blank columns. Since your worksheets at start at A1, the 'CurrentRegion' ends at the first non-blank row & column. The following code revision, which references the LastCell cell type, doesn't suffer that flaw:

    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

    You'll see that I've added a fair bit more code, too, to manage as much as possible of the table reformatting in Word. Even so, despite the code referencing .Cells.SpecialCells(xlCellTypeLastCell).Address, extra columns are sometimes included. I've added some code to delete these from the tables but you'll still get some tables that have empty columns off to the right, mostly in tables that have merged cells. You may or may not want to delete those columns, though their presence isn't evident unless you have Word configured to show gridlines and/or formatting marks.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Friday, November 29, 2013 5:34 AM
  • Hi Pual,

    Thank for your help.. the program runs well with the changes you have made...

    cheers,

    Crispin Lee

    Monday, December 2, 2013 7:58 AM
  • Hi,

    this code is absolutely perfect.
    but I have one problems, because this code only transformers excel to word without width a height cells
    how i can fix code for transformer excel to word one to one 

    First table is embedded excel and second table is transform excel to word
    Thanks for your advice.

    Picture:

    imgup.cz/image/LK43

    Tuesday, October 2, 2018 8:15 AM
  • Try replacing:

    .Characters.First.PasteAndFormat wdTableInsertAsRows

    with:

    .Characters.First.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, October 2, 2018 10:05 PM
  • Hi Paul, 

    I have copy the code above into my word files, however, some wordings and formats have been changed after i run the macro. Is it possible to help me ?

    Wednesday, August 5, 2020 1:19 PM