EXCELのVBAで質問があります。

質問

EXCELのVBAで質問があります。

次の処理を実現しようと、
　１．テンプレート的なファイルを用意する。
　２．作業ファイルの作業シート（VBA組み込み有）を
　　　初期化するために「１」のファイルからセルをコピーする
　　　※マクロがあるため、単純なシートコピーは出来ない

以下のようにコーディングしました。
　objXls = CreateObject("Excel.Application")
　objXlsWorkBook = objXls.Workbooks.Open("C:\Template.xls")
　objXlsSheet = objXlsWorkBook.Sheets("テンプレートシート")

　objXlsSheet.Range("1:10").Copy
　ActiveWorkbook.Worksheets("作業シート").Range("1:10").PasteSpecial

すると、コピーした内容がオブジェクト（図）として貼り付けられました。
どうすればオブジェクトではなく、セルとしてコピーが可能になるのでしょうか。

「Workbooks.Open("C:\Template.xls")」としてもいいのですが、
ファイルが見えてしまうのが都合が悪いのです。

どうかよろしくお願いします。

回答No.1

nicotinism · ベストアンサー

下記は自Bookから新規Bookへのコピペの場合です。
煮るなと焼くなと応用してください。
煮ても焼いても喰えなかったら・・・生ゴミの日にでも。
投稿用にタブを全角スペースに変換しています。

'新規ブックに指定範囲コピー
Sub cells_copy()
　　Dim xlsApp As Excel.Application
　　Dim xlsBookFrom As Excel.Workbook
　　Dim xlsBookTo As Excel.Workbook

　　Set xlsApp = CreateObject("Excel.Application")
　　Set xlsBookFrom = xlsApp.Workbooks.Open(ThisWorkbook.FullName, ReadOnly:=True)
　　Set xlsBookTo = xlsApp.Workbooks.Add

　　xlsBookFrom.Worksheets("Sheet1").Range("A1:D4").Copy _
　　　　Destination:=xlsBookTo.Worksheets("Sheet2").Range("E5")

　　xlsBookTo.Close SaveChanges:=True, Filename:="c:\test.xls"

　　Set xlsBookTo = Nothing
　　xlsBookFrom.Close SaveChanges:=False: Set xlsBookFrom = Nothing
　　Set xlsApp = Nothing

End Sub

回答No.2

Wendy02

不思議なコードです。VB.Netから写し込んだものだとは思いますし、Excel VBAのコードではありません。ただ、元がExcelを開いているのだから、Excel VBAで、 CreateObject("Excel.Application")という必要があるのでしょうか？オートメーションに換えてもよいですが、その場合は、GetObject を加えたほうがよいかと思います。

以下は、基本的なエラー処理は施してあります。既存のブックのマクロです。
それから、任意のシート、つまり、ActiveSheet に貼り付けるようになっていますから、違う場合は、切り替えてください。VB.Net でCOM参照設定の場合は、別途質問してください。一般の参照設定なら、オートメーションに替えるだけでよいです。

'//
Sub TestMacro1()
　Dim objXl As Object
　Dim xlSheet As Object
　Dim acSheet As Object
　Const mPATH As String = "C:\"　'パス
　Const FN As String = "Template.xls"
　On Error GoTo ErrHandler
　If StrComp(ActiveWorkbook.Name, FN, 1) = 0 Then Exit Sub
　Set acSheet = ActiveWorkbook.ActiveSheet　'ActiveSheet
　'Set acSheet =ActiveWorkbook.Worksheets ("作業シート")
　Set objXl = Workbooks(FN)
　Application.Goto acSheet.Cells(1, 1)
　Set xlSheet = objXl.Worksheets("テンプレートシート")
　Application.ScreenUpdating = False
　xlSheet.Rows("1:10").Copy acSheet.Cells(1, 1)
　objXl.Close False
　Application.ScreenUpdating = True
　Set objXl = Nothing
　Set acSheet = Nothing
　Exit Sub
ErrHandler:
　If Err.Number = 9 Then
　　If Dir(mPATH & FN) <> "" Then
　　　Set objXl = Workbooks.Open(mPATH & FN)
　　　Resume Next
　　Else
　　　MsgBox "ファイルが見つかりません。", 48
　　End If
　End If
End Sub