エクセル VBA シート保存ボタン
Sheet上にボタンを作成
ボタンを押すと保存するようにしています!
以前ここでSheet2枚をコピー出来るような
記述教えてもらったのですが・・
1枚ならどう変化して良いか・・
記述を書きましたが
何処が違うか教えて下さい!
Private Sub CommandButton1_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 = "ko"
'
Application.DisplayAlerts = False
Set OldWkbook = ActiveWorkbook
'
'ファイル名を取得
BkName = OldWkbook.Sheets(StName1).Range("A1").Value
FileName = BkName & Format(Now, "yyyy-mm") & ".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)).Copy
Set NewWkbook = ActiveWorkbook
For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count
NewWkbook.Sheets(1).Shapes(wIx).Delete
Next
NewWkbook.Sheets(1).Name = StName1
'
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
教えて下さい!
お礼
回答頂きありがとうございます。解決しました。