エクセルVBAでシート追加

質問

初めて質問します。
VBAで新しいシートを追加する時
同名のシート等があるとエラーになります。
追加するときシート名をチェックしたいのですが
どの様にすれば良いでしょうか？
また、シートは一番最後に追加したいです。
よろしくお願いします。

Sub Macro1()
x = InputBox("シート名")
Worksheets.Add.Name = x
End Sub

回答No.8

Wendy02

こんばんは。#6 のWendy02です。

>個別にチェックするのは無駄なことなのでしょうか？

その必要性があるかどうかです。しょせん、エラーはエラーで、そのエラーは、ユーザー本位の問題であって、それをマクロに依存するということは、無駄が多いと思います。以下で関数を作ってみましたので、ごらんください。ユーザー側の認識度だと思うのです。

>>それに、シートを追加するというユーザーの意思決定が、Excel側が、
>>名前が通らないので、取りやめるというロジックもヘンです。
>と書かれていますが、どうしてなのでしょうか？

この手のマクロというのは、必ず正しいシート名のシートを作らせるために作るのではないでしょうか?　本来のマクロの目的は、何かということですね。シート名を判断させるためのものか、それとも、シートを加えるためのものか、ということです。楽にシートを加えるために作るのではないのですか？エラーが出たら、本来は、そのままシートを加えて、手で直させるとか、その程度で良いと思います。

実務的には、あまり、複雑なことをさせても、結果がシート1枚ですから、VBAのロジックとして、もう少し単純に考えたほうが、楽だと思います。ご自身のマクロの勉強というなら、ぜひ、がんばってみるのもよいかとは思いますが、盛りだくさんに考えても、回答者にとっても、ご自身にとっても限界があると思うのです。

そう言った手前、一応、おっしゃっていることをVBAで表現してみました。たぶん、このような感じになるのではないかと私は思います。さらに、エラーレベル(ErrorLevel) を、細かく分類することも可能ですし、まだ、細かい点が抜けているかもしれません。そういう不安さが残る内容です。

'-----------------------------------------------------

Sub AddSheetMacro()
　　Dim ShName As Variant
　　Dim chk As Integer
　　Dim msg As String
　　'エラーメッセージ
　　Const MSG1 As String = "同名シートがあります" & vbCrLf
　　Const MSG2 As String = "シート名がないか,半角空白か,シート名が長すぎます" & vbCrLf
　　Const MSG3 As String = "シートでは使っていけない文字があります" & vbCrLf & _
　　　　　　　 "( : ),(\),(/), (?),(*), ([),(])" & vbCrLf

　　ThisWorkbook.Activate
　　ShName = Application.InputBox("シート名を入れてください", Type:=2)
　　If ShName = "" Or VarType(ShName) = vbBoolean Then Exit Sub
　　chk = ShNameCheck(ShName)
　　If chk = 0 Then
　　　 Worksheets.Add After:=Sheets(Sheets.Count)
　　Else
　　　 If chk = 1 Then
　　　　　msg = MSG1
　　　 ElseIf chk = 2 Then
　　　　　msg = MSG2
　　　 ElseIf chk = 3 Then
　　　　　msg = MSG3
　　　 Else
　　　　　msg = "複合的なエラーです"
　　　 End If
　 End If
　　If Len(msg) > 0 Then
　　　 MsgBox msg, vbInformation
　　End If
End Sub

'標準モジュールに必ず置いてください
Function ShNameCheck(ShName As Variant, Optional wb As Workbook) As Integer
　　Dim flg As Boolean
　　Dim ErrorLvl As Integer
　　Dim dummy As Variant
　　If wb Is Nothing Then Set wb = ActiveWorkbook
　　On Error Resume Next
　　dummy = wb.Worksheets(ShName).Range("A1").Value
　　If Err.Number = 0 Then
　　　　ErrorLvl = 1
　　End If
　　On Error GoTo 0
　　If Len(ShName) < 1 Or Len(ShName) > 31 Or StrComp(ShName, " ", 0) = 0 Then ErrorLvl = 2
　　If ShName Like "*[:\?*/]*" Then ErrorLvl = 3
　　If (InStr(ShName, "[") Or InStr(ShName, "]")) > 0 Then ErrorLvl = 3
　　ShNameCheck = ErrorLvl
End Function

お礼

Wendy02さん
たびたびありがとうございます。

勉強になりました。
エラーについての認識を考えてみます。
これに懲りず機会があればアドバイスよろしくお願いします。