エクセル/マクロ エラー処理がうまくいきません

質問

エクセルマクロの質問です。エクセルのヴァージョンは2000です。
シートをコピーして新シートに任意の名前を付けるマクロを作っています。

ユーザーフォームの中に一つのテキストボックス（新シートの名前入力用）と
二つのコマンドボタンを設置し一つは実行ボタン、もう一つはキャンセルボタンとしました。

テキストボックスに不正な名前（空白、記号、すでに存在するシート名）が入力された状態で
実行ボタンを押すと新シートは作成されず、メッセージボックスで実行できない旨が表示され、
入力フォームに戻るという感じにしようと思っています。

エラー処理には下記の通りOn Errorステートメントを試してみました。が、どうもうまくいきません。
エラーが出ても新しいシートが作成されてしまい、その後にメッセージボックスが出てしまいます。

正しいエラー処理の仕方をご教示頂けると幸いです。どうぞよろしくお願いします。

Private Sub CommandButton1_Click()

Dim NewSheetName As String
NewSheetName = TextBox1.Value

On Error GoTo Err1
Sheets("Summary").Select
Sheets("Summary").Copy After:=Sheets("Summary")
ActiveSheet.Name = NewSheetName

Exit Sub

Err1: MsgBox "Invalid name"
　　　Exit Sub

End Sub

回答No.3

ki-aaa · ベストアンサー

最初にシート名のチェックをするようにしました。

試してみて

Sub test()

Dim NewSheetName As String
'NewSheetName = TextBox1.Value
NewSheetName = "12/15"
NewSheetName = "12-15"

On Error Resume Next
Sheets("Summary").Name = NewSheetName
If Err.Number = 0 Then
Sheets(NewSheetName).Copy before:=Sheets(NewSheetName)
ActiveSheet.Name = "Summary"
Else
MsgBox "Invalid name"
End If
On Error GoTo 0

End Sub

お礼

'NewSheetName = TextBox1.Value
NewSheetName = "12/15"
NewSheetName = "12-15"
の部分は
NewSheetName = TextBox1.Value
に置き換えて試してみました。

元のページの名前を変えて、新しいページから元ページを作り直す・・・逆転の発想ですね。コードもシンプルな上に処理速度も速く、驚いています。

どうもありがとうございました。

回答No.2

Wendy02

あえて、Err1:があるので、それを残す方法としては、以下のようなコードはどうでしょう。昔、私が考えたコードです。あえて、On Error GoTo Err1　を生かしたコードですから、必ずしも、エラートラップが必要なわけではありません。

Private Sub CommandButton1_Click()
　Dim NewSheetName As String
　Const vbMyError As Integer = 513
　On Error GoTo Err1
　Worksheets("Summary").Select
　NewSheetName = TextBox1.Value
　If IsSheetName(NewSheetName) = False Then
　　 Err.Raise vbMyError
　End If
　Worksheets("Summary").Copy After:=Worksheets("Summary")
　ActiveSheet.Name = NewSheetName
　Exit Sub

Err1:
　If Err.Number = vbMyError Then
　　MsgBox "Invalid name"
　　TextBox1.Text = ""
　End If
End Sub
Private Function IsSheetName(ShName As String) As Boolean
'シート名のエラーチェック
　　Dim v As Variant
　　Dim i As Integer
　　Dim sh As Object
　　'文字列の長さの制限
　　If Len(ShName) > 31 Or Len(Trim(ShName)) < 1 Then IsSheetName = False: Exit Function
　　'使用出来ない文字の検出
　　For Each v In Array(":", "\", "/", "?", "*", "(", ")")
　　　　i = InStr(1, ShName, v, vbBinaryCompare)
　　　　If i > 0 Then IsSheetName = False: Exit Function
　　Next v
　　For Each sh In ActiveWorkbook.Sheets
　　　 If StrComp(sh.Name, ShName, vbTextCompare) = 0 Then IsSheetName = False: Exit Function
　　 Next sh
　　IsSheetName = True
End Function

回答No.1

f272

Sheets("Summary").Copy After:=Sheets("Summary")
ここでコピーしたが、エラーではない。新しいシートはコピーされる。

ActiveSheet.Name = NewSheetName
ここでエラーになる。だからコピーされたシートはそのまま残る。

ではどうするかと言えば、例えば、エラーに成ったときコピーされたシートを削除する。ついでにシートの削除で文句を言われないおまじないもいれておく。
Err1: MsgBox "Invalid name"
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Exit Sub