ＶＢＡ初心者

質問

いつも大変　たすけられております。
分かる方がみえましたらご教授いただけますと幸いです。

行いたい事
Excelで特定のシート（固定 仮に５sheet）のみを新しいブックとして保存したい。その際、ファイル名はユーザーが手入力で決められるようにしたい。

イメージでは、マクロボタンをクリックすると フォームが開き、その中にはテキストボックスがあり、その中に文字が新しいブックのファイル名となるように出来ますでしょうか。

回答No.8

kkkkkm

保存するときに同じファイルがあった場合上書きの確認が出ますがそのときに上書き保存しなかった場合エラーになります。
以下のサイトの方法のどちらかで回避してください。

保存時に同じ名前のファイルがあったときに確認して上書き保存するExcelマクロ
https://www.relief.jp/docs/excel-vba-save-same-file-name-confirmation.html

On Error Resume Next文を使う方を利用する場合

この後に何かコードを追加した場合に備えて

If Err.Number <> 0 Then
MsgBox "保存しませんでした。"
End If

の後に

On Error GoTo 0

としておいてください。

回答No.7

kkkkkm

> 保存したファイルが開き 開いたファイルは最小化なら効くのですが「×」をクリックしても閉じる事ができません。

ユーザーフォーム名がUserForm1として

開く時のコードを

UserForm1.Show vbModeless

として開くか

回答No.4の
Private Sub CommandButton1_Click()
のコードの最後に

Unload Me

として、最後にUserForm1を閉じるようにするか

最後に新規ファイルを閉じてしまうか

MsgBox "保存した新規ファイを閉じます", vbInformation
Workbooks(FileName).Close

どちらかで対応してください。

回答No.6

kkkkkm

ユーザーフォームにする場合、こんなユーザーフォームにしたらどうかなぁという余計なお世話の画像です。

回答No.5

kkkkkm

回答No.4の追加です。

名前を付けて保存 ダイアログの場合はフィル名として使えない文字はダイアログがメッセージで教えてくれますが、ユーザーフォームだと保存時にエラーになります。回避するにはファイル名に使えない文字をチェックするコードを記載する必要があります。

回避する一例です。
Excel VBA でファイル名に使えない文字を取り除く・チェックする
http://tanaka-misaki.blogspot.com/2012/02/excel-vba.html

回答No.4

kkkkkm

> こういった場合、名前を付けて保存 ダイアログを呼び出した方が早いのでしょうか。

ダイアログで指定してもらった場合、取得したデータはフルパスになりますので、もし利用者がフォルダを変更した場合は初期値でフォルダをデスクトップにしておいても別の場所に保存されてしまいます。

> ただ、ファイルの保存場所は デスクトップ としたいです。

という事ですので、他に保存されるのを避けるためには取得したデータからファイル名だけを取り出しデスクトップに保存するようにする必要があります。

たとえば

Sub Test()
Dim FileName As Variant
Dim Path As String, WSH As Variant
Set WSH = CreateObject("WScript.Shell")

Path = WSH.SpecialFolders("Desktop")
ChDir Path
FileName = Application.GetSaveAsFilename(FileFilter:="Excelファイル,*.xlsx")
If FileName = False Then
Exit Sub
End If
FileName = Mid(FileName, InStrRev(FileName, "\") + 1)
ThisWorkbook.Sheets("Sheet3").Copy
ActiveWorkbook.SaveAs Path & "\" & FileName
Set WSH = Nothing
End Sub

上記の場合、利用者が保存場所を変更したのにそこに保存されてないと勘違いする可能性はあります。

ユーザーフォームを使ったら(CommandButton1 とTextBox1として)

Private Sub CommandButton1_Click()
Dim FileName As Variant
Dim Path As String, WSH As Variant

If Me.TextBox1 = "" Then
MsgBox "ファイル名が必要です", vbCritical
Exit Sub
End If

Set WSH = CreateObject("WScript.Shell")
Path = WSH.SpecialFolders("Desktop")
FileName = Me.TextBox1.Text & ".xlsx"
ThisWorkbook.Sheets("Sheet3").Copy
ActiveWorkbook.SaveAs Path & "\" & FileName
Set WSH = Nothing
End Sub

補足

以前ご回答いただいてから少し期間があいての補足となり申し訳ございません。
上記ほうほう、特に後半の方法を試させて頂いているんですが、保存したファイルが開き 開いたファイルは最小化なら効くのですが「×」をクリックしても閉じる事ができません。
元のExcelに戻りフォームを閉じると、操作が出来るようになります。
解決方法はあるでしょうか。

回答No.3

imogasi

Basic時代から、Input（ステートメント）というのがある。
Sub test01()
Filename = InputBox("XXのファイルネーム入力 ")
MsgBox Filename '確認用
End Sub
ーー
VBAをやりだしたのなら、使えるVBAのステートメントを一度総ざらえで名前だけでも勉強しておくべきだ。
TextBoxを使うとか、そういう方法もあるが、その次の学習課題だろう。

回答No.2

kkkkkm

ユーザーフォームは以前の回答を参考にして作成していただいて
シートのコピーは前回のコピーのコードの以下の部分を変更して実行してみてください。

コピーのコードはボタンクリックのイベントに記載してください。

NewWbName = "新規ブック.xlsx"

NewWbName = Me.TextBox1.Text

補足

お世話になっております。

上手くたどり着けず、改めて伺っても良いでしょうか。

テキストボックスを作成し、そのボックス内の文字で名前を付けて保存 というマクロを作りたいです。
ただ、ファイルの保存場所は デスクトップ としたいです。

こういったことは可能でしょうか。
時間も空いており閲覧できるか分かりませんが、ご確認頂けますと幸いです。
こういった場合、名前を付けて保存 ダイアログを呼び出した方が早いのでしょうか。

回答No.1

f272

こんな感じ？
Sub sample2()
Dim FileName As Variant
Sheets("５sheet").Copy
FileName = Application.GetSaveAsFilename(InitialFileName:="InitialFileName.xlsx", FileFilter:="Excelファイル,*.xlsx")
If FileName = False Then
Exit Sub
End If
ActiveWorkbook.SaveAs FileName
End Sub