#1
|
|||
|
|||
Macro to export a table to Word
Hi,
I've found this nice macro that works fine to copy/paste a table from Excel to Word: Code:
Sub Export() Dim wdApp As Object Dim wd As Object On Error Resume Next Set wdApp = GetObject(, "Word.Application") If Err.Number <> 0 Then Set wdApp = CreateObject("Word.Application") End If On Error GoTo 0 Set wd = wdApp.Documents.Add wdApp.Visible = True Sheets("INV").Activate Set Rng = ThisWorkbook.ActiveSheet.Range("A1:D200") Rng.Copy With wd.Range .Collapse Direction:=wdCollapseStart .InsertParagraphAfter .Collapse Direction:=wdCollapseStart .PasteSpecial DataType:=1 With .Find .ClearFormatting .Text = vbTab .Replacement.ClearFormatting .Replacement.Text = " " .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue End With End With End Sub So in the Word doc I have a bunch of empty lines in my table depending on the number of rows is my Excel table. I've tried to integrate this macro inside my main macro but I can't get it to work, maybe because at first it was a Word macro, dunno if there are differences. Code:
Sub DeleteEmptyCol2TableRows() Application.ScreenUpdating = False Dim Tbl As Table, i As Long With ActiveDocument For Each Tbl In .Tables With Tbl For i = .Rows.Count To 1 Step -1 If Len(.Cell(i, 2).Range.Text) = 2 Then .Rows(i).Delete Next i End With Next Tbl End With Application.ScreenUpdating = True End Sub It could work fine if I run this macro from Word after the Word doc has been created but I'd like to run all from Excel in one click. Any idea? |
#2
|
||||
|
||||
You had it almost right the first time, but you need to set the last row e.g. as follows. You also need to set the numeric values of the Word commands or they won't work with late binding. You haven't defined all your variables.
Code:
Option Explicit Sub Export() Dim wdApp As Object Dim wd As Object Dim xlSheet As Worksheet Dim rng As Range Dim LastRow As Long Const wdReplaceAll As Long = 2 Const wdFindContinue As Long = 1 On Error Resume Next Set wdApp = GetObject(, "Word.Application") If Err.Number <> 0 Then Set wdApp = CreateObject("Word.Application") End If On Error GoTo 0 Set wd = wdApp.Documents.Add wdApp.Visible = True Set xlSheet = ActiveWorkbook.Sheets("INV") With xlSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row Set rng = .Range("A1:D" & LastRow) rng.Copy With wd.Range .Collapse Direction:=1 .InsertParagraphAfter .PasteSpecial DataType:=1 With .Find .ClearFormatting .Text = vbTab .Replacement.ClearFormatting .Replacement.Text = " " .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue End With End With End With End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Works perfect! Thanks you so much
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Looking for Macro to Export Images | alex20850 | Word VBA | 2 | 01-10-2019 06:27 PM |
Export embedded .txt or .csv file from Word bookmark to Access table field | eric.okeefe | Word VBA | 4 | 08-29-2017 09:31 AM |
Word Macro to delete table row and table header | NorthSuffolk | Word VBA | 6 | 10-11-2016 05:04 AM |
Macro to count and export results | rm7885 | Word VBA | 3 | 07-23-2014 12:41 PM |
Microsoft word table export ? -need help- | --alexander-- | Word | 2 | 04-17-2013 11:13 PM |