Solved: Copying data from excel to word

Hey,

I have a question that involves moveing data from excel to word.
how do I do this the best way?

The way it has to work is that depending on which cell that has a value, the cells with a value in has to be moves to Word where there has to be inserted some text to.

I know that I can do this with bookmarks but is this a good way of doing it? :think:

The values are put after each others depending on which cell have values in.

hope this make sense?

Thanks in advance.

Birch81

Bookmark is the best way IMO, and just select the data from VBA before copying.

Okay I might need a little help here.

How do I copy a specific cell value to a specific word bookmark?

I need a hint.

Birch81

Here is a simple example

[vba]

Sub CopyToWord()
Dim appWord As Object
Dim appDoc As Object

Set appWord = CreateObject("Word.Application")
Set appDoc = appWord.documents.New("C:\MyDoc.doc")
appDoc.Bookmarks("MyBookmark").Range.Text = Worksheets(1).Range("A26").Value
appWord.Visible = True
End Sub
[/vba]

Quote:

---

Originally Posted by Birch81

Hey,

I have a question that involves moving data from excel to word.
how do I do this the best way?

---

I like early binging, but it has drawbacks, too.

Quote:

---

The way it has to work is that depending on which cell that has a value, the cells with a value in has to be moves to Word where there has to be inserted some text to.

---

You'll have to get Xld to help with conditional macro running.

Quote:

---

I know that I can do this with bookmarks but is this a good way of doing it? :think:

---

Depends on what you are doing in Word.

[vba]Sub ControlWordFromXL()
'First set a reference to Word (in the VB Editor, select Tools + References).
Dim oWord As Word.Application
Dim WordWasNotRunning As Boolean
Dim oDoc As Word.Document

'Get existing instance of Word if it's open; otherwise create a new one

On Error Resume Next

Set oWord = GetObject(, "Word.Application")
If Err Then
Set oWord = New Word.Application
WordWasNotRunning = True
End If

On Error GoTo Err_Handler

Set oDoc as oWord.Activedocument

oWord.Visible = False

On Error GoTo Err_Handler

oDoc.Bookmarks("My BookMark").Range.Text = _
activeworkbook.WorkSheets(1).Range("A1").Value

oDoc.Close savechanges:=wdDoNotSaveChanges

If WordWasNotRunning Then
oWord.Quit
End If

'Make sure you release object references.

Set oWord = Nothing
Set oDoc = Nothing
Set myDialog = Nothing

'quit
Exit Sub

Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " _
& Err.Number
If WordWasNotRunning Then
oWord.Quit
End If

End Sub
[/vba]

Quote:

---

Originally Posted by Tinbendr

I like early binging, but it has drawbacks, too.

---

I much prefer late binging, crashing out afterwards works better for me.

Thanks for the quick replys.

I´ll try working with my documents.

Thank you.

Birch81

Double post.

Hey again.

I have tryed this but I get an error saying
"Runtime error "424"
"Objerct required"

[vba]Sub Transfer_to_Word()
Set appwd = CreateObject("word.application")
appwd.Visible = True
appwd.Documents.Open Filename:="H:/tilbudsskabelon_macro1.docm"

appDoc.Bookmarks("SamletExMoms").Range.Text = ActiveWorkbook.Worksheets(1).Range("F24").Value
End Sub
[/vba]

In my word document I have a bookmark called SamletExMoms.

Birch81

Can you post the Excel and Word docs for us to try it.

Sure.

Here´s the docm file

This worked fine for me

[vba]

Sub Transfer_to_Word()
Dim appWord As Object
Dim appDoc As Object

Set appWord = CreateObject("Word.Application")

Set appDoc = appWord.Documents.Open(Filename:="H:/tilbudsskabelon_macro1.docm")

appWord.Visible = True
appDoc.Bookmarks("SamletExMoms").Range.Text = ActiveWorkbook.Worksheets(1).Range("F24").Value

End Sub
[/vba]

Works here to :)

Thank you very much.

Hey again,

Can you help med underline some text?

[vba]If ActiveWorkbook.Worksheets(1).Range("F24").Value <> "" Then

appDoc.Bookmarks("txtTotalNyInst").Range.Text = "Ialt" & vbTab & "kr." & vbTab & _
Format(ActiveWorkbook.Worksheets(1).Range("F24").Value, "##,##0.00") & vbCrLf & vbTab

End If[/vba]

I haft to underline this part
"kr." & vbTab & Format(ActiveWorkbook.Worksheets(1).Range("F24").Value, "##,##0.00")
but how do I do that? Can I do it inside a bookmark?

[vba]

Sub Transfer_to_Word()
Const wdUnderlineSingle As Long = 1
Const WORD_FILE As String = "H:/tilbudsskabelon_macro1.docm"
Const BOOKMARK As String = "SamletExMoms"
Dim appWord As Object
Dim appDoc As Object

Set appWord = CreateObject("Word.Application")

Set appDoc = appWord.Documents.Open(Filename:=WORD_FILE)

appWord.Visible = True
With appDoc.Bookmarks(BOOKMARK).Range

.Text = ActiveWorkbook.Worksheets(1).Range("F24").Value
.Font.Underline = wdUnderlineSingle
End With

Set appDoc = Nothing
Set appWord = Nothing
End Sub
[/vba]

Thanks again Xld :)

I´ll try working with it.

If you want to test if word is already started, try this

[vba]

Public Sub Transfer_to_Word()
Const wdCharacter As Long = 1
Const wdUnderlineSingle As Long = 1
Const WORD_FILE As String = "H:/tilbudsskabelon_macro1.docm"
Const BOOKMARK As String = "SamletExMoms"
Dim appWord As Object
Dim appDoc As Object

On Error Resume Next
Set appWord = GetObject(, "Word.Application")
On Error GoTo 0
If appWord Is Nothing Then

Set appWord = CreateObject("Word.Application")
appWord.Visible = True
End If

On Error Resume Next
Set appDoc = appWord.Documents(WORD_FILE)
On Error GoTo 0
If appDoc Is Nothing Then

Set appDoc = appWord.Documents.Open(Filename:=WORD_FILE)
End If

With appDoc.Bookmarks(BOOKMARK).Range

.Text = ActiveWorkbook.Worksheets(1).Range("F24").Value
.Font.Underline = wdUnderlineSingle
End With

Set appDoc = Nothing
Set appWord = Nothing
End Sub
[/vba]

Hey xld,

Thank you for all the help you have assisted me with. I have come a long way with my document now but I still need a little help :)

Is there a way to delete bookmarks if I can see it is not used?

That is when I press my button in excel and I want to transfer my data to Word. Then when I can see that a bookmark is not used I want to delete it. Is this Possible?

Ahh I belive I found a solution on my problem.

Hey Again,

I how figured out how to delete my bookmarks.

[VBA]If ActiveWorkbook.Worksheets(1).Range("F22").Value = "" Then

appDoc.Bookmarks("txtFremtidNyInst").Delete
appDoc.Bookmarks("txtFremtidNyInstPris").Delete

End If[/VBA]

But in my word documents I have listed alot of bookmarks and I have made a space between them so that they don´t stand in the same place and can´t be moved. But when I delete the bookmark I also want to delete the space I have made.
How is this possible?

Perhaps your "spaces" also need to be bookmarks, then these too can be deleted by excel.


That's my first advice on this board, LOL.
Advice just given was serious.

How do you do that?

The first question is....when you place your text/values/variables into the word document, is the word document 100% blank/empty , OR , does the word document already contain some text/values.

I am constructing a similiar project....
see....http://www.vbaexpress.com/forum/showthread.php?t=33669
In brief, I populate an excel spreadsheet, and press the macro button.
This then opens specific word doc, find/replace using data from excel, then delete specific paragraphs, then save word doc as word_doc_2.
The basis of my find/replace and delete paragraphs is wholly based upon pre-existing bookmarks.

(NB - not at work til Monday, so cant access my script til then)


If you can answer my question (at top of this post), this will determine how you tackle this.

The document is clean when I start transfering data to it. It has alot of text and bookmarks.

I was thinking of some kind of backspace. I just don´t know how to get i working. There is a function called TypeBackspace.

Can anyone help me on how to get this function working?

Anyone ?

I don't work in MSWord that often so there is probably a shorter way but here is one.

I attached a sample doc to play with. I just set a current sheets A2 and B2 to be empty to test. A1:B3 had values otherwise. I named the bookmarks with an excel prefix and the cell name to make iteration easy.

I prefer formfields over bookmarks when doing this sort of thing myself.

[vba]Sub ExportCellsToWordBookMarks()
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim mywdRange As Word.Range
Dim bm As Word.Bookmark, bmName As String, s As String
Dim r As Excel.Range
Dim doc As String

doc = "x:\msword\ExportCellsToWordBookMarks.docx"
If Dir(doc) = "" Then
MsgBox "Error, file does not exist." & vbLf & doc, vbCritical, "File is Missing"
Exit Sub
End If

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo errorHandler

Set myDoc = wdApp.Documents.Add(Template:=doc)
wdApp.Visible = True

For Each bm In myDoc.Bookmarks
bmName = bm.Name
If Left(bmName, 5) = "excel" Then
Set r = Excel.Range(Right(bmName, Len(bmName) - 5))
If r.Value = "" Then
bm.Select
wdApp.Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
s = wdApp.Selection.Text
While Left(s, 1) = " "
wdApp.Selection.TypeBackspace
wdApp.Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
s = wdApp.Selection.Text
Wend
wdApp.Selection.MoveRight
bm.Delete
Else
bm.Range.Text = r.Value
End If
End If
Next bm

Set wdApp = Nothing
Set myDoc = Nothing
Set mywdRange = Nothing
Exit Sub

errorHandler:
MsgBox "Unexpected error: " & Err.Number & vbLf & Err.Description
Resume errorExit
End Sub

[/vba]