|
こんにちは
その処理の前後のコードでエラー時の処理をきちんと入れてみて下さい。
Sub CopyPasteWord()
Dim objWord As Object
Dim objDoc As Object
Dim WkBook As Workbook
Dim WkSht As Worksheet
Dim BOOK As String
Dim wordfilename As Variant
Dim OPENBOOK As String
BOOK = ThisWorkbook.Sheets(1).Cells(12, 2)
OPENBOOK = ThisWorkbook.Path & "\" & BOOK & ".xls"
If Len(Dir(OPENBOOK)) = 0 Then Exit Sub
With Application
.AskToUpdateLinks = False
.DisplayAlerts = False
Set WkBook = Workbooks.Open(OPENBOOK)
wordfilename = Application.GetOpenFilename _
(Title:="ファイルを開く", _
FileFilter:="Word 文書(*.doc),*doc")
'事情によりWordだけGetOpenFilenameメソッドを利用しています
If VarType(wordfilename) = vbBoolean Then
WkBook.Close False
Set WkBook = Nothing
Exit Sub
End If
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
Set WkSht = WkBook.Worksheets(1)
'ここでExcelからWordにCopyPaste
'コードは省略します。
objDoc.Close
objWord.Quit
.DisplayAlerts = True
.AskToUpdateLinks = True
End With
Set objWord = Nothing
Set objDoc = Nothing
Set WkBook = Nothing
Set WkSht = Nothing
End Sub
|
|