Excel data naar Word kopieeren

[Pekke06]

Ik heb een een stukje VBA code wat prima werkt. In die code kopieer ik een selectie vanuit Excel naar Word, geef het word-document een naam en sla het dan op.
Tot zover dus geen probleem.
Als variant daarop wil ik dat het programma stopt na aanmaken van het Word-bestand. En belangrijk dat ik ook het Word bestand vol in beeld krijg. Met de volgende code zie in in de status balk wel dat Word geopend is en als ik daarop klik komt deze ook te voorschijn, maar dat moet automatisch.
Mijn Code:
Sub WordUp() 'zend een excel range naar word
Dim WdObj As Object, fname As String
fname = Sheets("Blad1").[E21].Value
Set WdObj = CreateObject("Word.Application")

On Error GoTo Errorchecker

WdObj.Visible = True 'False or True
WdObj.Application.Visible = True

'Sheets(1).UsedRange.Copy
Sheets("Blad1").Range("A712").Copy
WdObj.documents.Add
WdObj.Selection.Paste

Application.CutCopyMode = False

If fname <> "" Then 'make sure fname is not blank
With WdObj
.ChangeFileOpenDirectory "G:klad"
.ActiveDocument.SaveAs Filename:=fname & ".doc"
End With
Else:
MsgBox ("File not saved, naming range was botched, guess again.")
End If
' onderstaande code sluit Word zonder wijzigingen mee te nemen
' With WdObj
' .ActiveDocument.Close False
' .Quit
'End With
Set WdObj = Nothing
Exit Sub

Errorchecker:
Select Case Err.Number
Case 4198
MsgBox ("Please select range to copy!")
Range("A1").Select
Case Else
MsgBox ("Operation Failed...sorry!")
End Select

End Sub
Weet iemand hoe dat moet

Alvast Bedankt

 

[snb]

    Application.ActivateMicrosoftApp xlMicrosoftWord

 

[Pekke06]

Beste SNB,

Het werkt inderdaad, waarvoor dank. Maar er wordt dan een nieuw document geopend.
Ik wil graag het document zichtbaar dat ik aanmaak vanuit excel

 

[snb]

Application.ActivateMicrosoftApp xlMicrosoftWord
with getobject("","Word.Application")
.selection.paste

end with

 

[Pekke06]

Opgelost !!

Beste SNB,

Bedankt voor je antwoorden. Ik weet niet precies hoe ik jouw code moet plaatsen, maar door jouw code ben ik op het volgende gekomen (opgezocht via googlen op delen van jouw oplossing):
If fname <> "" Then 'make sure fname is not blank
With WdObj
.ChangeFileOpenDirectory "G:klad"
.ActiveDocument.SaveAs Filename:=fname & ".doc"
.Documents.Open Filename:=fname & ".doc"
End With
Else:
MsgBox ("File not saved, naming range was botched, guess again.")
End If
De vetgedrukte regel toegevoegd en nu werkt het perfect.

SNB nogmaals bedankt