|
こんにちは
こんな感じでうまく行くでしょうか?
Sub CopyPasteWord()
Dim objWord As Object
Dim objDoc As Object
Dim WkSht As Worksheet
Dim BOOK As String
Dim wordfilename As Variant
With Application
.AskToUpdateLinks = False
.DisplayAlerts = False
' BOOK = ThisWorkbook.Sheets(1).Cells(12, 2)
' OPENBOOK = ThisWorkbook.Path & "\" & BOOK
' Workbooks.Open OPENBOOK
wordfilename = Application.GetOpenFilename _
(Title:="ファイルを開く", _
FileFilter:="Word 文書(*.doc),*doc")
'事情によりWordだけGetOpenFilenameメソッドを利用しています
If VarType(wordfilename) = vbBoolean Then Exit Sub
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.documents.Open(wordfilename)
Else
Set objDoc = GetObject(wordfilename)
End If
On Error GoTo 0
With objWord
.Visible = True
.WindowState = 1 'wdWindowStateMaximize
End With
'ここでExcelからWordにCopyPaste
'コードは省略します。
objDoc.Close
objWord.Quit
.DisplayAlerts = True
.AskToUpdateLinks = True
End With
Set objWord = Nothing
Set objDoc = Nothing
End Sub
|
|