| |
以前、枠線の非表示でお世話になりました。
今回は、新規ブックを作成させてそのブックにシートを
コピーしたいと思っています。以前も利用していた下記
コードで’シート１書き込みの所にマクロで記録した
コードを入れたのですがエラーになってしまいます。
なにせ初心者なので見当違いの質問かもしれませんが
よろしくお願いします。
Private Sub CommandButton2_Click()
Dim objApp 'Excelアプリ
Dim objBook 'ExcelBook
Dim objSheets 'ExcelSheets
Dim objSheet 'ExcelSheet
Dim strMsg 'エラーメッセージ
Dim strXlsPath '保存Excelファイル
Dim i
Dim xlNormal
Dim myDate As String
xlNormal = -4143
'Excel の保存先
myDate = Format(ActiveSheet.Range("f14"))
myDate2 = Format(ActiveSheet.Range("w14"))
strXlsPath = "C:\Documents and Settings\sim\デスクトップ\" _
& myDate & myDate2 & ".xls"
'=====================================================================
'Excelを起動する
'=====================================================================
On Error Resume Next
Err.Clear
Set objApp = CreateObject("Excel.Application")
If Err Then
'エラー処理
strMsg = strMsg & "Excelを起動できませんでした" & vbCrLf
strMsg = strMsg & "Err.Number:" & Err.Number & vbCrLf
strMsg = strMsg & "Err.Description:" & Err.Description & vbCrLf
End If
'エラー処理の初期化
On Error GoTo 0
If strMsg <> "" Then
'エラーメッセージの表示
MsgBox strMsg, vbCritical, "Excel の作成"
Else
'===================================================================
'新規ワークシートを作成
'===================================================================
objApp.Workbooks.Add
'非表示にする
objApp.Application.Visible = False
'確認ダイアログを表示させない
objApp.DisplayAlerts = False
Set objBook = objApp.ActiveWorkbook
Set objSheet = objBook.Sheets(1)
シート1のみ残して後は削除
For i = 2 To objSheets.Count
objBook.Sheets(2).Delete
Next
'シート１の書き込み
'Set objSheets = Sheets("作業シート")
Sheets("作業シート").Copy Before:=Workbooks(objBook).Sheets(1)
'新規ブックを保存
objBook.SaveAs Filename:=strXlsPath, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
CreateBackup:=False
'読み取り専用で
'ReadOnlyRecommended:=True,
'Excelの終了
objApp.DisplayAlerts = True '確認ダイアログを表示させる
objBook.Close
objApp.Quit
'オブジェクトの解放
Set objSheet = Nothing
Set objSheets = Nothing
Set objBook = Nothing
Set objApp = Nothing
'エラーメッセージの表示
MsgBox "Excel を作成しました。", vbInformation, "Excel の作成"
End If
End Sub
|
|
おとと
- 10/4/17(土) 10:28 -
