Solved

VBA - Create Word table and copy excel cell data

Posted on 2011-02-14
3
554 Views
Last Modified: 2012-05-11
Hi Guys,

I'm pulling some data into excel which is generally 5 columns by about 20 rows of data but can differ. What I need to do is select all the data in excel then create a table in word with the same about of columns and rows and then paste the data into the word table.
The word  table also needs to have the grid lines separating the columns and rows.
Just wondering if anyone has dome something similar in the past and can offer some advise on the best way to do it with vba code
Thanks

Gavin
0
Comment
Question by:victoriaharry
3 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
Comment Utility
0
 
LVL 76

Expert Comment

by:GrahamSkan
Comment Utility
This is a Word macro, and needs a reference set to the Microsoft Excel Object Library.
Sub TableFromExcel()
    Dim xlApp As Excel.Application
    Dim xlWbk As Excel.Workbook
    Dim xlWks As Excel.Worksheet
    Dim tbl As Word.Table
    Dim r As Integer
    Dim c As Integer
    Dim b As WdBorderType
    
    Set xlApp = New Excel.Application
    Set xlWbk = xlApp.Workbooks.Open("C:\MyFolder\MyWorkbook.xls")
    xlApp.Visible = True
    Set xlWks = xlWbk.Sheets(1)
    
    Set tbl = ActiveDocument.Tables.Add(ActiveDocument.Bookmarks("\EndOfDoc").Range, 20, 5)
    For b = wdBorderVertical To wdBorderTop
        tbl.Borders(b).LineStyle = wdLineStyleSingle
        tbl.Borders(b).LineWidth = wdLineWidth025pt
    Next b
    For r = 1 To 20 'start row to end row
        For c = 1 To 5 'startcolumn to end column
            tbl.Cell(r, c).Range.Text = xlWks.Cells(r, c).Value
        Next c
    Next r
    
    xlWbk.Close
    xlApp.Quit
End Sub

Open in new window

0
 
LVL 18

Accepted Solution

by:
WarCrimes earned 500 total points
Comment Utility
Gavin,

I create automated reports from Excel for work.  My best practices would include the following:

1)Use late binding, as opposed to early binding as in Graham's solution.  This way if you share the code with anyone, they won't have to go and set a Reference to Word to be able to use the code.  If you want to use early binding for code development so that you can see what's available in the library as you are coding, then that is fine, but I recommend late binding for releasing the code into production.

2)Create a Word template with a Table style for use when pasting the Excel data into Word.  This way you don't have to code all the formatting options, and also, if someone wants to create the table manually, they can have the exact same formatting as someone who creates it via the macro.

Below are some example snippets of code for both opening a Word document from your template and also for pasting the data and setting the table style.  There are some global variables in the code which are in ALL_CAPS.  You can set these up if you want or just hard code them.  You'll also notice the svType variable.  I have 3 templates (Title, Portrait, Landscape) which I use depending on the situtation.  I also use APIs, which is where the SW_MINIMIZE comes from.  It hides the window so you don't see the document being created in the background.  You can remove this if you desire.

The InsertExcelTable Sub is an example of how I move data from Excel to Word and set the table style.  You can edit this however you see fit, but I like to pass the range to be copied and the wdDoc object I want to paste into.  The style "ALI Table" is the Table style I have set up in my Word templates.

There are many ways to 'skin a cat', but hopefully you will find this an efficient one.  You will notice it is not dependent on your Excel range's size.  It will copy whatever you tell it to.  If you aren't sure how big your table will be, just use something along the lines of:

wsModel.Range("A1").CurrentRegion.Copy

where wsModel is a worksheet object and Range("A1") is a cell that you know will ALWAYS be in the table you want to copy.  This method only works if the table in Excel is not connected to any other data, which I would assume would be the case for 99.9% of tables.

Cheers,

WC
Public Const TEMPLATE_DIRECTORY As String = "\\your_directory_here\"
Public SAVE_DIRECTORY As String  'this isn't a constant in my program as it is set dynamically in multiple places.  you'll need to set it inside of a subroutine.

Declare Function ShowWindow Lib "user32" ( _
                            ByVal hWnd As Long, _
                            ByVal nCmdShow As Long _
                            ) As Long

' Constants for ShowWindow()
Public Const SW_HIDE As Long = 0
Public Const SW_NORMAL As Long = 1
Public Const SW_SHOWMINIMIZED As Long = 2
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOWNOACTIVATE As Long = 4
Public Const SW_SHOW As Long = 5
Public Const SW_MINIMIZE As Long = 6
Public Const SW_SHOWMINNOACTIVE As Long = 7
Public Const SW_SHOWNA As Long = 8
Public Const SW_RESTORE As Long = 9
Public Const SW_SHOWDEFAULT As Long = 10

Public Function WordCreateEmptyReport(svName As String, Optional svDir As String, Optional svType As String = "Title") As Variant
    
    '*********** Use for development of code **************
    'Dim wrdApp As Word.Application
    'Dim wrdDoc As Word.Document
    'Dim wddoc As Word.Document
    '*********** Use for deployment of code **************
    Dim wrdApp As Object
    Dim wrdDoc As Object
    Dim wdDoc As Object
    '*****************************************************
    Dim wdHwnd As Long
    Dim tmpSaveName As String

    If svDir = "" Then svDir = SAVE_DIRECTORY
    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    If Err = ERR_APP_NOT_RUNNING Then Set wrdApp = CreateObject("Word.Application")
    If Not wrdApp.UserControl Then
        wrdApp.Visible = True
        wrdApp.Visible = False
    End If
    Set wrdDoc = wrdApp.documents("Template_" & svType & "_Page.doc")
    If Err = 4160 Then Set wrdDoc = wrdApp.documents.Add(TEMPLATE_DIRECTORY & "Template_" & svType & "_Page.dot")
    Err.Clear
    
    wdHwnd = FindWindow(vbNullString, "Template_" & svType & "_Page.doc (Read-Only) - Microsoft Word")
    ShowWindow wdHwnd, SW_MINIMIZE
    With wrdDoc
        tmpSaveName = PublicFunctions.ReplaceInvalidNameCharacters(svName)
        'Check to see if a .doc file with the saveName is already open, and if so, close it
        Set wdDoc = wrdApp.documents(tmpSaveName & ".doc")
        If Err = 0 Then wdDoc.Close True
        Err.Clear
        Set wdDoc = Nothing
        .SaveAs fileName:=svDir & "\" & tmpSaveName & ".doc"
    End With
        
    On Error GoTo 0
    Set WordCreateEmptyReport = wrdDoc
End Function

Public Function ReplaceInvalidNameCharacters(str As String) As String
    Dim strFind As Variant
    Dim strReplace As Variant
    Dim chr As Long
      
    strFind = Array("/", "\", "^", "*", "# ", "#", "<=", ">=", "<", ">", "=", "?", "|", ": ", ":", """", "'", " -", " ")
    strReplace = Array("_", "_", "_", "x", "", "", "lte", "gte", "lt", "gt", "eq", "_", "_", "_", "_", "", "", "", "_")
    For chr = LBound(strFind) To UBound(strFind)
        str = WorksheetFunction.Substitute(str, strFind(chr), strReplace(chr))
    Next chr
    Do While InStr(1, str, "__") > 0
        str = WorksheetFunction.Substitute(str, "__", "_")
    Loop
    ReplaceInvalidNameCharacters = str
End Function

Private Sub InsertExcelTable(xlRng as Range, wdDoc As Object)
    With wdDoc
        xlRange.Copy
        .paragraphs.last.Range.Paste
        Call PublicSubs.WordSetTableStyle(wdDoc, .tables.Count, "ALI Table")
    End With
End Sub

Public Sub WordSetTableStyle(wdDoc As Object, tblNum As Long, sty As String)
    With wdDoc
        .tables(tblNum).Style = sty
        .tables(tblNum).Select
        wdDoc.Parent.Selection.ClearFormatting
        Call WordAddParagraph(wdDoc)
    End With
End Sub

Public Sub WordAddParagraph(wdDoc As Object)
    With wdDoc.paragraphs.last.Range
        .Collapse direction:=0
        .insertparagraphafter
    End With
End Sub

Open in new window

0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

I would like to show you some basics you can do with Mailings in MS Word. It´s quite handy feature you can use for creating envelopes, labels, personalized letters etc. First question could be what is this feature good for? Mailing can really he…
This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used.  One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to…
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now