Solved: Existing codes need help PLS

Dear Experts,

I have the following this set of code that can paste excel range A1:A100 to a Word doc. However, the range, after being pasted to Word, remains a table.
Please how do I insert some codes to this vba to convert the pasted range from table to text. I know how to convert table to text but I dont know how to code this action to my vba below.

Many thanks for any help.
Nee

[VBA]Option Explicit
Sub Screenshot()
'transfers XL range with format to Word doc
'makes changes to "c:\Test.doc" Change directory to suit
Dim Wdapp As Object, Rng As Range, c As Range
Sheets("sheet1").Range("A1:A100").Select 'change range to suit
Set Rng = Selection
For Each c In Rng
c.BorderAround Weight:=xlThin, ColorIndex:=2
Next c
Selection.Copy 'Picture xlScreen, Format:=xlBitmap
On Error GoTo Errmsg
Set Wdapp = CreateObject("Word.Application")
Wdapp.ChangeFileOpenDirectory "c:\"
Wdapp.documents.Open Filename:="Test.doc"
With Wdapp.activedocument
.Range(0, .Characters.Count).Delete 'clears document
.Range(0).Paste
End With
Application.CutCopyMode = False
Wdapp.Visible = True
Exit Sub
Errmsg: MsgBox "You have an error"
Wdapp.Quit
Set Wdapp = Nothing
End Sub[/VBA]

Hi Nee,

Try this. Made a change to avoid the need to select your data and avoid the loop too. Directly formatting using With clauses will be faster than the loop. :) Also added another Set WdApp = Nothing line, as that was missed before your error handler.

[vba]Sub Screenshot()
'transfers XL range with format to Word doc
'makes changes to "c:\Test.doc" Change directory to suit
Dim Wdapp As Object, Rng As Range, c As Range
With Sheets("sheet1").Range("A1:A100") 'change range to suit
With .Borders(xlInsideHorizontal)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeTop)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeLeft)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeRight)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeBottom)
.Weight = xlThin
.ColorIndex = 2
End With
.Copy
End With
On Error GoTo Errmsg
Set Wdapp = CreateObject("Word.Application")
Wdapp.ChangeFileOpenDirectory "c:\"
Wdapp.documents.Open Filename:="Test.doc"
With Wdapp.activedocument
.Range(0, .Characters.Count).Delete 'clears document
.Range(0).PasteSpecial DataType:=2
End With
Application.CutCopyMode = False
Wdapp.Visible = True
Set Wdapp = Nothing
Exit Sub
Errmsg: MsgBox "You have an error"
Wdapp.Quit
Set Wdapp = Nothing
End Sub[/vba]

HTH,

Hello Ken,

Many thanks for the revised codes!
I hope you allow me to add this question -- I was so forgetful and missed it from my previous post:

* How do I copy the range to a new Word doc instead of having to rely on an existing doc in my C drive.

Also, when I ran the revised code I lost the original formatting (like some words are bold and in red - I mean, when I manually did the convert from Word, I was able to keep the existing format that I had in the pasted table).

Nee

Hi Nee,

Changes to above include:
-Pasting to a new document, not an existing one
-Deleted line to clear the document. Since it's new, it isn't necessary
-Change the pastespecial to a constant of 1 (RTF Format instead of Text format). This will retain your colours and fonts
-Got rid of unused variables

[vba]Sub Screenshot()
'transfers XL range with format to Word doc
'makes changes to "c:\Test.doc" Change directory to suit
Dim Wdapp As Object, wdDoc As Object
With Sheets("sheet1").Range("A1:A100") 'change range to suit
With .Borders(xlInsideHorizontal)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeTop)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeLeft)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeRight)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeBottom)
.Weight = xlThin
.ColorIndex = 2
End With
.Copy
End With
On Error GoTo Errmsg
Set Wdapp = CreateObject("Word.Application")
Set wdDoc = Wdapp.documents.Add
With wdDoc
.Range(0).PasteSpecial DataType:=1
End With
Application.CutCopyMode = False
Wdapp.Visible = True
Set Wdapp = Nothing
Exit Sub
Errmsg: MsgBox "You have an error"
Wdapp.Quit
Set Wdapp = Nothing
End Sub[/vba]

Hope it helps,

Gd Morning Ken,

Many thanks for your extra help. The codes work beautifully!!!
Very appreciative.

Nee

kpuls,

excellent code!

Quote:

Originally Posted by tonyrosen

kpuls,

excellent code!

Absolutely!

Ken -- I'm back to thank you again for the great cake and wondering if I may ask for some frosting ;)
I'd love to be able to "convert table to text" (I mean the range that
turns to a table after its copied and pasted to Word from Excel).

I know I've reached my limit ... so pls ignore if this asks too much of your time ...

Nee

Quote:

Originally Posted by Nee

Ken -- I'm back to thank you again for the great cake and wondering if I may ask for some frosting ;)
I'd love to be able to "convert table to text" (I mean the range that
turns to a table after its copied and pasted to Word from Excel).

I know I've reached my limit ... so pls ignore if this asks too much of your time ...

Nee

Frosting? That was part of your original question, and I totally missed that the change I put in reverted back to the table pasting. My apologies!

Give this one a shot:

[vba]Sub Screenshot2()
'transfers XL range with format to Word doc
'makes changes to "c:\Test.doc" Change directory to suit
Dim Wdapp As Object, wdDoc As Object
With Sheets("sheet1").Range("A1:A100") 'change range to suit
With .Borders(xlInsideHorizontal)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeTop)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeLeft)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeRight)
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlEdgeBottom)
.Weight = xlThin
.ColorIndex = 2
End With
.Copy
End With
On Error GoTo Errmsg
Set Wdapp = CreateObject("Word.Application")
Set wdDoc = Wdapp.documents.Add
With wdDoc
.Range(0).PasteSpecial DataType:=1
With .Parent
.Selection.Tables(1).Select
.Selection.Rows.ConvertToText Separator:=0, NestedTables:=True
.Selection.ParagraphFormat.Alignment = 0
End With
End With
Application.CutCopyMode = False
Wdapp.Visible = True
Set Wdapp = Nothing
Exit Sub
Errmsg: MsgBox "You have an error"
Wdapp.Quit
Set Wdapp = Nothing
End Sub[/vba]

Could probably be a little cleaner in the word side, but should do the trick. :)

Hi guys,

At the risk of overlooking some things, why not use something along the lines of this:

[VBA]Sub Screenshot3()
'transfers XL range without format to Word doc
Dim Wdapp As Object, wdDoc As Document
Sheets(1).Range("A1:A100").Copy
On Error GoTo Errmsg
Set Wdapp = CreateObject("Word.Application")
Set wdDoc = Wdapp.documents.Add
wdDoc.Content.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _
wdInLine, DisplayAsIcon:=False
Wdapp.Visible = True
Application.CutCopyMode = False
Set Wdapp = Nothing
Exit Sub
Errmsg: MsgBox "You have an error"
Wdapp.Quit
Set Wdapp = Nothing
End Sub[/VBA]

What's the point pasting your Excel data into a table in a Word document when you'll be deleting the table afterwards right?
I had to set a reference to the Microsoft Word 9.0 Object Library (9.0 is the highest number on my computer for that library) to make it work.

Regards,

Rembo

Hello Gentlemen,

So thankful for the help from you all.

Ken: I'm so appreciative of your generosity / patience in donating the one set of codes after another!

Remco: Quite a while! thanks a bunch too for helping me with the codes.

They all work nicely!

Warm regards,
Nee

Quote:

Originally Posted by Rembo

Hi guys,

At the risk of overlooking some things, why not use something along the lines of ...

What's the point pasting your Excel data into a table in a Word document when you'll be deleting the table afterwards right?
I had to set a reference to the Microsoft Word 9.0 Object Library (9.0 is the highest number on my computer for that library) to make it work.

Heya Remco! :)

Actually, I think my first version should have done that. The deal was though, that while it lost the table, it also lost the formatting. (I used a late bind, hence the PasteSpecial = 0 instead of PasteAsText.

Not saying at all that mine is the right way, but I was able to make it work with keeping formats and removing the table.

Hi Ken and Nee,

Quote:

Originally Posted by Nee

Remco: Quite a while! thanks a bunch too for helping me with the codes.

Yes, it's been a little while. Every now and then I surface to see what's new. This is quite a forum;there are some very skilfull people at work here.

Quote:

Originally Posted by kpuls

..but I was able to make it work with keeping formats and removing the table.

Yup, that's a pretty crafty solution you scribbled down :) I also stored it on my computer for reference. The solution I presented ignores the formate completely.