VBA 保存

質問

保存ボタンを作成してファイルに飛ぶように
させていますが…どうしてもエラーになります！
エラー表示内容＞
実行時エラー１００４
シートの名前を他のシート、Visual Basicで参照される
オブジェクト　ライブラリまたは
ワークシートと同じ名前に変更することはできません。

下記は実際の記述です。
Private Sub 保存_Click()
Dim FileName As String
Dim FileExt As String
Dim BkName As String
Dim OldWkbook As Workbook
Dim NewWkbook As Workbook
Const StName1 As String = "計画 グラフ"
Const StName2 As String = "ケア一覧"
'
Application.DisplayAlerts = False
Set OldWkbook = ActiveWorkbook
'
'ファイル名を取得
BkName = OldWkbook.Sheets(StName1).Range("D1").Value
FileName = BkName & Format(Now, "yyyy-mm-dd") & ".XLS"
'
FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName)
If FileName = "" Then
Exit Sub
Else
If Right(FileName, 4) <> ".XLS" Then
MsgBox "ファイル名が異常です。"
Exit Sub
End If
End If
'
OldWkbook.Sheets(Array(StName1, StName2)).Copy
Set NewWkbook = ActiveWorkbook
For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count
NewWkbook.Sheets(1).Shapes(1).Delete '←シート1のボタンを削除
Next
NewWkbook.Sheets(1).Name = StName1
NewWkbook.Sheets(2).Name = StName2
'
FileName = "D:\看護計画保存\" & FileName
'
If Dir(FileName) <> "" Then
'##ファイルが既に存在する
If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then
NewWkbook.Close savechanges:=False
'##保存せずに終了
Exit Sub
End If
'##指定ファイル置き換え保存
NewWkbook.SaveAs FileName:=FileName
Else
'##ファイルを新規保存
NewWkbook.SaveAs FileName:=FileName
End If
'
NewWkbook.Close savechanges:=False
Application.DisplayAlerts = True
End Sub

回答No.3

Wendy02 · ベストアンサー

こんばんは。

ご質問の問題は、質問の文章の中では書かれていない部分があるような気がします。

ただ、同じ作業をするコードを書く場合は、注意点があります。

>OldWkbook.Sheets(Array(StName1, StName2)).Copy

これ自体は問題ないのですが、私は、もう何年もVBAを書いていますが、こういうしゃれた書き方はほとんどしません。複数のシートをSelect して、作業グループ・シートにするときだけです。このコードですと、シートモジュールまで持ってきてしまっています。コントロールツールをコピー後で消すという手法は、出来る限り避けたほうがよいです。

コードとしては汚くなりますが、以下のようにしてみたらいかがですか？
こういう書き方があります。

'-------------------------------------------
　''OldWkbook.Sheets(Array(StName1, StName2)).Copy 'この部分とShape(1).Deleteをやめて
　　'新しいブックを作ったときのシートの枚数
　　n = Application.SheetsInNewWorkbook
　　Application.SheetsInNewWorkbook = 2
　　Set NewWkbook = Workbooks.Add
　　With NewWkbook
　　　OldWkbook.Worksheets(StName1).Cells.Copy .Worksheets(1).Range("A1")
　　　.Sheets(1).Name = StName1
　　　OldWkbook.Worksheets(StName2).Cells.Copy .Worksheets(2).Range("A1")
　　　.Sheets(2).Name = StName2
　　End With
　　Application.SheetsInNewWorkbook = n
'-------------------------------------------

お礼

ありがとうございます！
うまく出来ました！
しかし、SHeetの型式や印刷プレビューの
形式なども初期化していました。
これは、
どうにもならないのですか？
すいません！是非教えていただきたいです。

回答No.5

kmetu

> OldWkbook.Sheets(Array(StName1, StName2)).Copy
> Workbooks(2).Activate
> Set NewWkbook = ActiveWorkbook
> で記述で良いのでしょうか？

ブックが1個しか開いていないのでしたら
その記述でかまいません。
Workbooks(2).Activateは2番目のブックをアクティブにすると言う意味です。

> 新規に作成とは最初からするのでしょうか？

該当部分だけを新しいブックにコピーしてテストしてみてください。
それで上手くいったら他の部分もコピーしてください。

お礼

何度も質問してしまい
すいませんでした。

問題は解決できました。
今後とも宜しくお願いします！

回答No.4

Wendy02

こんにちは。

>しかし、SHeetの型式や印刷プレビューの
>形式なども初期化していました。
>これは、
>どうにもならないのですか？

SHeetの型式や印刷プレビューの形式とは何のことですか？
具体的に何を指すのですか？

「印刷プレビュー」というのは、概ね「印刷範囲」であろうとは思いますが、「SHeet」の型式という、型式というのは、年代だとすれば、Excel 4.0. Excel 5.0 ダイアログというものがありますが、そういうものは、一般シートとは互換性がありません。

お礼

ありがとうございました！
上手く記述ができました。
回答にあったように印刷範囲のことです！

今後も是非
指導の方をお願いします。
私ももっともっと
勉強が必要です。頑張りますので
困ったときには助けて下さい！

回答No.2

kmetu

こちらで実行したらエラーが出ずに実行されるのですが…
もしかしたら
OldWkbook.Sheets(Array(StName1, StName2)).Copy
の部分で新しいブックがアクティブになっていないかもしれませんので
新しいブックをアクティブにしてから
(Workbooks(2).Activateとか)
Set NewWkbook = ActiveWorkbook
を実行してみてはいかがでしょう。

また、ファイルが壊れている可能性もありますので
新規に作成して実行してみてはいかがでしょう。

お礼

＜新しいブックをアクティブにしてから
どのようにすれば良いのですか？
すいません！初心者ですので。
OldWkbook.Sheets(Array(StName1, StName2)).Copy
Workbooks(2).Activate
Set NewWkbook = ActiveWorkbook
で記述で良いのでしょうか？

＞また、ファイルが壊れている可能性もありますので
＞新規に作成して実行してみてはいかがでしょう。
新規に作成とは最初からするのでしょうか？

回答No.1

kmetu

OldWkbook.Sheets(Array(StName1, StName2)).Copy
この時点でシートの名前は継承されてますから

NewWkbook.Sheets(1).Name = StName1
NewWkbook.Sheets(2).Name = StName2

は不要だと思われます

お礼

ありがとうございます！！
ただ
不要部分を削除しても
上手く保存先に移らず
エラーが表示されます！

どこに問題があるのでしょうか？