View Single Post
  #1   Report Post  
Posted to microsoft.public.word.vba.general,microsoft.public.excel.programming
Hari Prasadh[_2_] Hari Prasadh[_2_] is offline
external usenet poster
 
Posts: 83
Default Pasting Tables from Excel to Word

Hi,

I have to paste lot of tabulated data from excel to word. I have programmed
in Excel and pasted the code below.

Basically I look for the Word "Table " in Excel and copy the range till the
next instance of the word "Table "

Then I go to Winword and paste it. After pasting the present table I have to
do following 2 additional things in Word:-
A) I have to go to the end of the document - The excel code --
SDocument.Range.EndOf Unit:=wdStory, Extend:=wdExtend -- doesnt make the
cursor go to the end of the word document (Neither do I get any error). What
would be the correct code to make cursor go to end of Word document?

B) I have to then insert a Page Break after the present table- The Excel
code -- SDocument.Range.InsertBreak Type:=wdSectionBreakNextPage --
strangely clears the freshly pasted data. I have also tried the code
SDocument.Range.InsertBreak Type:=wdSectionBreakNextPage but this created a
page break ABOVE the freshly pasted data. How to create a page break after
the presently pasted data?

After doing the above the control goes back to excel and the process keeps
on repeating till there are no more words.

I have one more issue which is after pasting the Column Widths of table in
Word are thoroughly different as compared to what I have in Excel. The whole
table shoots off the right side of word margin. I have close to 26 columns
in excel and before pasting I reduce the widths and then copy but even then
in word it gets expanded. What is the syntax for controlling the column
width of a freshly pasted table?

Thanks a lot,
Hari
India

Option Explicit
Dim TableCount As Integer
Public SWinword As Word.Application
Public SDocument As Word.Document

Sub ExcelRangeProcess()

Dim TableStartRow As Long
Dim TableEndRow As Long
Dim EndColumnLetter As String
Dim MaxNumberofTable As Integer
Dim LastRow As Long
Dim CheckFortable As Boolean

LastRow = Range("A65536").End(xlUp).Row

'In my case EndColumnLetter is Z.
EndColumnLetter = InputBox("Enter the last Column LETTER in your PRESENT
Banner", "Banner Column")


In my case number of tables would be around 150.
MaxNumberofTable = InputBox("Enter the Number of Tables in your PRESENT
Banner")

Range("A1" & ":" & EndColumnLetter & LastRow).Select

Selection.Find(what:="TABLE ", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

TableStartRow = ActiveCell.Row + 10

For TableCount = 1 To MaxNumberofTable

Range("A" & TableStartRow & ":" & EndColumnLetter & LastRow).Select

Selection.Find(what:="TABLE ", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate

If Left(ActiveCell.Value, 6) = "TABLE " Then
CheckFortable = True
Else
CheckFortable = False
End If


While CheckFortable < True

Range("A" & ActiveCell.Row + 1 & ":" & EndColumnLetter & LastRow).Select

Selection.Find(what:="TABLE ", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
_
MatchCase:=True, SearchFormat:=False).Activate

If Left(ActiveCell.Value, 6) = "TABLE " Then CheckFortable = True

Wend


TableEndRow = ActiveCell.Row - 6

Range("A" & TableStartRow & ":" & EndColumnLetter & TableEndRow).Select
Selection.Copy
Call TransferToWord

TableStartRow = TableEndRow + 16

Next TableCount

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''Calling
WORD
application''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''

Sub TransferToWord()

If TableCount = 1 Then

Set SWinword = CreateObject("Word.application")
SWinword.Visible = msoTrue
Set SDocument = SWinword.Documents.Add

Else

Set SWinword = GetObject(, "Word.application")

End If


SDocument.Range.PasteAndFormat (wdPasteDefault)

SDocument.Range.EndOf Unit:=wdStory, Extend:=wdExtend

SDocument.Range.InsertBreak Type:=wdSectionBreakNextPage

End Sub