|
▼kanabun さん:
アドバイスありがとうございます。
以下の様に書きなおしましたが
実行時エラー"1004"
GetSaveAsFilename"メゾットは失敗しました_Applicationオブジェクト
のエラーが発生しました
SaveFile = Application.GetSaveAsFilename(SaveFile, "*.xls")が黄色になりました。
構文は以下の通りです。また、ワークシート(2種類A.B)を指定して出力は可能でしょうかよろしくお願いいたします。
Private Sub CommandButton39_Click()
Dim Target As Range
Dim count_WAREA As Integer
Dim IRow As Long
Set Target = ActiveSheet.UsedRange.Resize(, 52)
Target.Select
If MsgBox("定期試験DBを新規bookに保存しますか?", vbOKCancel) _
= vbCancel Then Exit Sub
Dim SaveFile
SaveFile = CreateObject("WScript.Shell"). _
SpecialFolders("DeskTop") & "\バックアップ定期試験データ.book"
SaveFile = Application.GetSaveAsFilename(SaveFile, "*.xls")
If VarType(SaveFile) = vbBoolean Then Exit Sub
'(1)新規Bookをシート枚数1枚で 追加する。
Set NewBook = Workbooks.Add(6)
'(2) 元のBookの指定シートのUsedRange.Resize(,52) の範囲を _
Copyして、新規BookのSheets(1).Range("A1")に貼り付ける。
Target.Copy NewBook.Sheets(1).Range("A1")
'(3)新規Bookをbook形式で保存する
With NewBook
.SaveAs SaveFile, xlbook, Local:=True
.Save
.Close
End With
MsgBox "book形式で保存しました", , SaveFile
Set Target = Nothing
Set NewBook = Nothing
End Sub
|
|