Hello All,
I am using Windows XP/Office 2003

I am running this macro from excel (downloaded from newsgroup) which
reads the information from Word Tables in Excel.

Sub ImportDoc()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdTable As Word.Table
Dim wdRow As Word.Row
Dim wdCell As Word.Cell
Dim nRow, nCol, nTab
Dim bHeader As Boolean
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(Filename:="C:\Test.doc")
wdApp.Visible = True
'Call or insert your table copying code here
Range("A1:E999").Clear
nTab = 1
nRow = 1
For Each wdTable In wdDoc.Tables
nTab = nTab + 1
bHeader = True
For Each wdRow In wdTable.Rows
nCol = 1
nRow = nRow + 1
For Each wdCell In wdRow.Cells
nCol = nCol + 1
With ActiveSheet.Cells(nRow, nCol)
.Select
.Font.Bold = bHeader
If bHeader Then
.HorizontalAlignment = xlCenter
Else
.HorizontalAlignment = xlHAlignGeneral
End If
End With
wdCell.Range.Copy
ActiveSheet.Paste
Next
bHeader = False
Next
nRow = nRow + 1
Next


wdApp.ActiveDocument.Close
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing


End Sub

I am facing the folloiwng problems with the above macro.
When the macro runs

1) Word Document (Test.doc) is shown after about 10-15 second on the
screen with the cursor blinking - I wish this not to be displayed

2) Excel file is displayed reading from the Word Table and inserting
info in the cells of Excel...this process is very very slow.. It takes
about two to two and a half minutes to insert a 40 Rows x 11 Columns
information.

3) I have to select all rows and column and do Autofit manually for
rows and columns - Can this be done automatically.



Can anyone help me to speed up this please?

TIA

Rashid Khan

Untested...
'---
Sub ImportDoc_R1()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdTable As Word.Table
Dim wdRow As Word.Row
Dim wdCell As Word.Cell
Dim nRow As Long
Dim nCol As Long
Dim bHeader As Boolean

Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(Filename:="C:\Test.doc")
'wdApp.Visible = True
Application.ScreenUpdating = False
ActiveSheet.Range("A1:E999").Clear
nRow = 1
For Each wdTable In wdDoc.Tables
bHeader = True
For Each wdRow In wdTable.Rows
nCol = 1
nRow = nRow + 1
For Each wdCell In wdRow.Cells
nCol = nCol + 1
With ActiveSheet.Cells(nRow, nCol)
.Font.Bold = bHeader
If bHeader Then
.HorizontalAlignment = xlCenter
Else
.HorizontalAlignment = xlHAlignGeneral
End If
wdCell.Range.Copy
.Paste
End With
Next
bHeader = False
Next
nRow = nRow + 1
Next

Set wdTable = Nothing
Set wdRow = Nothing
Set wdCell = Nothing
wdDoc.Close SaveChanges:=wdDoNotSaveChanges
Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing
Application.ScreenUpdating = True
End Sub
--
Jim Cone
Portland, Oregon USA
Special Sort add-in review: http://www.contextures.com/excel-sort-addin.html

..
..
..

"prkhan56"
wrote in message
Hello All,
I am using Windows XP/Office 2003
I am running this macro from excel (downloaded from newsgroup) which
reads the information from Word Tables in Excel.

-snip-

I am facing the folloiwng problems with the above macro.
When the macro runs
1) Word Document (Test.doc) is shown after about 10-15 second on the
screen with the cursor blinking - I wish this not to be displayed

2) Excel file is displayed reading from the Word Table and inserting
info in the cells of Excel...this process is very very slow.. It takes
about two to two and a half minutes to insert a 40 Rows x 11 Columns
information.

3) I have to select all rows and column and do Autofit manually for
rows and columns - Can this be done automatically.

Can anyone help me to speed up this please?
TIA
Rashid Khan

Hello Jim,
After running the macro I get the following error.

Run time error 438
Object doesn't support this property.

Thanks for your time


On Aug 4, 6:37*pm, "Jim Cone" wrote:
Untested...
'---
Sub ImportDoc_R1()
*Dim wdApp As Word.Application
*Dim wdDoc As Word.Document
*Dim wdTable As Word.Table
*Dim wdRow As Word.Row
*Dim wdCell As Word.Cell
*Dim nRow As Long
*Dim nCol As Long
*Dim bHeader As Boolean

*Set wdApp = New Word.Application
*Set wdDoc = wdApp.Documents.Open(Filename:="C:\Test.doc")
'wdApp.Visible = True
*Application.ScreenUpdating = False
*ActiveSheet.Range("A1:E999").Clear
*nRow = 1
*For Each wdTable In wdDoc.Tables
* *bHeader = True
* *For Each wdRow In wdTable.Rows
* * *nCol = 1
* * *nRow = nRow + 1
* * *For Each wdCell In wdRow.Cells
* * * *nCol = nCol + 1
* * * *With ActiveSheet.Cells(nRow, nCol)
* * * * *.Font.Bold = bHeader
* * * * * If bHeader Then
* * * * * * .HorizontalAlignment = xlCenter
* * * * * Else
* * * * * * .HorizontalAlignment = xlHAlignGeneral
* * * * * End If
* * * * * wdCell.Range.Copy
* * * * *.Paste
* * * *End With
* * *Next
* * *bHeader = False
* *Next
* *nRow = nRow + 1
*Next

*Set wdTable = Nothing
*Set wdRow = Nothing
*Set wdCell = Nothing
*wdDoc.Close SaveChanges:=wdDoNotSaveChanges
*Set wdDoc = Nothing
*wdApp.Quit
*Set wdApp = Nothing
*Application.ScreenUpdating = True
End Sub
--
Jim Cone
Portland, Oregon *USA
Special Sort add-in review: *http://www.contextures.com/excel-sort-addin.html

.
.
.

"prkhan56"
wrote in message
Hello All,
I am using Windows XP/Office 2003
I am running this macro from excel (downloaded from newsgroup) which
reads the information from Word Tables in Excel.

-snip-

I am facing the folloiwng problems with the above macro.
When the macro runs
1) Word Document (Test.doc) is shown after about 10-15 second on the
screen with the cursor blinking - I wish this not to be displayed

2) Excel file is displayed reading from the Word Table and inserting
info in the cells of Excel...this process is very very slow.. It takes
about two to two and a half minutes to insert a 40 Rows x 11 Columns
information.

3) I have to select all rows and column and do Autofit manually for
rows and columns - Can this be done automatically.

Can anyone help me to speed up this please?
TIA
Rashid Khan

At what line in the code does the error occur?
'--
Jim Cone

On Aug 4, 7:06*pm, "Jim Cone" wrote:
At what line in the code does the error occur?
'--
Jim Cone

I changed the line as per your suggestion.
I stepped into the code (F8) I receive after .Paste on the following
line

wdCell.Range.Copy
.Paste

Thanks once again

Yup...

Change .Paste to .PasteSpecial
'--
Jim Cone


"prkhan56" wrote in message
...
On Aug 4, 7:06 pm, "Jim Cone" wrote:
At what line in the code does the error occur?
'--
Jim Cone

I changed the line as per your suggestion.
I stepped into the code (F8) I receive after .Paste on the following line

wdCell.Range.Copy
.Paste

Thanks once again

Update:

Change...
wdDoc.Close SaveChanges:=wdDoNotSaveChanges

To...
wdDoc.Close SaveChanges:=0
'--
Jim Cone