|
みなさん、こんばんわ。よしです。
最初に質問したものを改造し、下記のようにしてみたのですが、すでにオープン
している場合に2重オープンを「いいえ」と選択すると、「Openメソッドが
失敗しました」というメッセージが表示されてしまい、とりあえず、エラーを
無視する形で対処致しました。このような対処は通常しないものなのでしょうか?
他にいい方法があればご教授願えないでしょうか。よろしくお願い致します。
Sub DMPブック作成()
' コピー元ブック名
Dim originalBook As String
originalBook = ActiveWorkbook.Name
' コピー先ブック名
Dim copyBook As String
' コピー先シート番号
Dim sheetNum As String
' コピー先ブック名を取得する。
ChDir "\Documents and Settings\よし\デスクトップ\作業"
On Error Resume Next
copyBook = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
If (copyBook <> "False") Then
Workbooks.Open Filename:=copyBook
Else
Exit Sub
End If
On Error GoTo 0
' コピー先シート番号を取得
sheetNum = Application.InputBox(prompt:="何番目のシートにコピーしますか?", Type:=2)
If sheetNum = "False" Then
Exit Sub
Else
If (CInt(sheetNum) < 1 And CInt(sheetNum) > 4) Then
MsgBox ("1 から 4の間で指定してください。")
Exit Sub
End If
End If
' 選択範囲の内容をコピーする。
Workbooks(originalBook).Activate
Selection.Copy
' 新規ワークブックを作成し貼り付ける。その際、列幅を最適化する。
Workbooks(Dir(copyBook)).Worksheets(CInt(sheetNum)).Activate
Worksheets(CInt(sheetNum)).Cells(2, 1).Select
ActiveSheet.Paste
Selection.Columns.AutoFit
End Sub
|
|