View Single Post
 
Old 03-07-2015, 01:38 AM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,138
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

The following does what you asked

Code:
Option Explicit
Sub ProcessTable()
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim xlRange As Object
Dim oTable As Table
Dim oRng As Range
Dim oDoc As Document
Dim fDialog As FileDialog
Dim strWorkbookname As String
'Check document is valid
If ActiveDocument.Tables.Count = 0 Then GoTo err_handler
If ActiveDocument.Tables(1).Rows.Count < 31 Then GoTo err_handler
If ActiveDocument.Tables(1).Columns.Count < 2 Then GoTo err_handler
'Select the workbook
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = "Select the workbook to process"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Workbooks", "*.xls* "
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , _
                   "List Folder Contents"
            Exit Sub
        End If
        strWorkbookname = .SelectedItems(1)
    End With
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo lbl_Exit
    'Open the workbook and set the required range
    Set xlBook = xlApp.Workbooks.Open(Filename:=strWorkbookname)
    Set xlSheet = xlBook.Sheets("Internal")
    Set xlRange = xlSheet.Range("A7:B31")
    'Copy the range
    xlRange.Copy
    'Close the workbook
    xlBook.Close SaveChanges:=False
    'Set the document to process and the table range
    Set oDoc = ActiveDocument
    Set oTable = oDoc.Tables(1)
    Set oRng = oDoc.Range(Start:=oTable.Cell(7, 1).Range.Start, _
                          End:=oTable.Cell(31, 2).Range.End)
    'Paste and format the data in the table
    With oRng
        .Paste
        .Font.name = "Trebuchet MS"
        .Font.Size = 10
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Cells.VerticalAlignment = wdCellAlignVerticalCenter
    End With
    'CleanUp
lbl_Exit:
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlRange = Nothing
    Set oDoc = Nothing
    Set oTable = Nothing
    Set oRng = Nothing
    Exit Sub
err_handler:
    MsgBox "The activedocument does not appear to be the correct document?"
    GoTo lbl_Exit
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote