エクセルVBAでシート追加

質問

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

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

回答No.4

merlionXX · ベストアンサー

> また、シートは一番最後に追加したいです。

これを忘れてました。

Sub test01()

x = InputBox("シート名")

If LenB(x) > 31 Then
MsgBox "名前が長すぎます。"
Exit Sub
End If

For Each st In Worksheets
If st.Name = x Then
MsgBox "すでに同名のシートがあります。"
Exit Sub
End If
Next

On Error GoTo line
Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
ws.Name = x
Set ws = Nothing
Exit Sub

line:
MsgBox "名前に不適切な文字があります。"

End Sub

お礼

ありがとうございます
お手数をおかけ致しました。
出来ました！！　感謝です。
何から何まで本当にありがとうございました。

回答No.9

noname#31387

こんばんは kasoukenです

シートを追加するだけのご質問ですが
＃多分これだけではないと思いますが
自分用ならNO1のmerlionXXさんが書かれている様にします。
他の方が使用するならクラスモジュールに書くと思います。
クラスモジュールに書く必要があるかは別にしてですが。
ようは、誰が使うかで使い分けています。

Wendy02さんも書かれていますが、
>この手のマクロというのは、必ず正しいシート名のシートを作らせるために作るのではないでしょうか?　本来のマクロの目的は、何かということですね。
だと思います。
Wendy02さん。引用させて頂きました。すいません。

あと、変数の宣言はした方が良いです。

お礼

ありがとうございました

参考にさせて頂きます
またよろしくお願いします。

回答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さん
たびたびありがとうございます。

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

回答No.7

noname#31387

お邪魔します。
ありがちなチェック方法ですが関数作ってみました。
まだチェックする所があるかも・・・
Sub Smp1()
Dim newSheName As String
Dim AddSheet As Worksheet
Dim cName As String
newSheName = VBA.InputBox("シート名")
If VBA.Len(newSheName) = 0 Then
　　　Exit Sub
End If
cName = NameCheck(newSheName)
If cName = "OK" Then
　　　With Worksheets
　　　　　Set AddSheet = .Add(after:=.Item(.Count))
　　　　　AddSheet.Name = newSheName
　　　　　Set AddSheet = Nothing
　　　End With
Else
　　　MsgBox cName
End If
End Sub
'---------------------------------------------
Function NameCheck(xName As String) As String
Dim xShe As Worksheet
On Error Resume Next
Set xShe = Sheets(xName)
If Not xShe Is Nothing Then
　　　NameCheck = "同名"
　　　Set xShe = Nothing
　　　Exit Function
End If
On Error GoTo 0
With CreateObject("VBScript.RegExp")
　　　.Pattern = "[\\/:\?\[\]\*]"
　　　　　If .Test(xName) Then
　　　　　　　NameCheck = "不可の文字あり"
　　　　　　　Exit Function
　　　　　End If
End With
If VBA.LenB(VBA.StrConv(xName, vbFromUnicode)) > 31 Then
　　　NameCheck = "31文字以内(半角)"
　　　Exit Function
End If
NameCheck = "OK"
End Function

補足

ありがとうございます
チェックできました。

少し教えてください
Kasoukenさんは
いつもこのようなエラーチェックをしているのでしょうか？

回答No.6

Wendy02

こんにちは。

今、ちょっとレスの応答をみていて、こちらでも調べてみたのですが、なぜ、#1のmerlionXX さんや#2のzap35さんのコードでいけないのでしょうか？ロジックとして間違っていないはずです。

>同名のエラーや文字数の超過など個別に
>チェックする方法は難しいのでしょうか？

それらを個別にチェックすれば、確かにいくつかの該当する問題は出てくるのでしょうけれど、それらを事前に、個々にチェック関数やプロシージャを作るというのは、かなり面倒だと思います。

しかし、Excelを扱うユーザーとして、ある程度の常識的な中でシート名をつけるのであって、それが通るか通らないかは、最終的にExcelのApplication 任せにしてよいと思うのです。これは、オブジェクト指向にも通じることですが、ブラックボックス＝結果論だと思います。

基本的には、Excelでは、ワークシート名が通るか通らないかの独自のVBA関数には用意されていないのです。出来ないわけではありません。確か、API関数に、ファイル名が有効かどうかの関数があったので、代用できるような気がしますが、シート名の仕様を全部調べて、そのエラーをユーザーにメッセージとして返すというのは、大変なことだと思います。

別の言い方をすると、シート名の決め事は、Excelの入門レベルの問題だと思うのです。もし、そういうユーザーを対象とするなら、シートを追加場合は、すでに、「キメウチ」でシート名をつけてしまうというのが良いと思うのです。

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

補足

ありがとうございます
少し教えてください。
個別にチェックするのは無駄なことなのでしょうか？

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

回答No.5

zap35

＃０２です。文字数チェックと不適文字の置換を入れてみました

Sub ShAdd()
Dim x
Dim LastSH, idx As Integer
Dim ActSH As Worksheet
Set ActSH = ActiveSheet
x = Application.InputBox("シート名は？", 2)
If x = False Then
Else
x = Replace(x, "/", "") '不適文字（例）を置換
x = Replace(x, "\", "")
x = Replace(x, "*", "")
x = Replace(x, "?", "")

If Len(x) > 10 Then '文字数チェック
MsgBox ("シート名は１０文字以内にしてください")
Exit Sub
End If

For idx = 1 To Worksheets.Count
If Worksheets(idx).Name = x Then '重複名チェック
MsgBox ("同名のシートが存在します")
Exit Sub
End If
Next idx

Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = x
ActSH.Activate
End If
End Sub

お礼

ありがとうございます
お手数をおかけ致しました。
色んな方法が有るのですね。
勉強になりました。感謝です。

回答No.3

merlionXX

> 同名のエラーや文字数の超過など個別に
> チェックする方法は難しいのでしょうか？

#1のmerlionXXです。
では、これではいかがでしょう？

Sub test01()

x = InputBox("シート名")

If LenB(x) > 31 Then
MsgBox "名前が長すぎます。"
Exit Sub
End If

For Each st In Worksheets
If st.Name = x Then
MsgBox "すでに同名のシートがあります。"
Exit Sub
End If
Next

On Error GoTo line
Worksheets.Add.Name = x
Exit Sub

line:
MsgBox "名前に不適切な文字があります。"

End Sub

回答No.2

zap35

マクロを書いてみました（少し大げさにしすぎたかもしれません）
重複名がある場合は「シート名-(2)」で追加します

Sub ShAdd()
Dim x
Dim LastSH, idx As Integer
Dim ActSH As Worksheet
　Set ActSH = ActiveSheet
　x = Application.InputBox("シート名は？", 2)
　If x = False Then
　Else
　　For idx = 1 To Worksheets.Count
　　　If Worksheets(idx).Index = Worksheets.Count Then
　　　　LastSH = idx
　　　End If
　　　If Worksheets(idx).Name = x Then
　　　　x = x & "-(2)"
　　　End If
　　Next idx
　　Worksheets.Add after:=Worksheets(LastSH)
　　ActiveSheet.Name = x
　　ActSH.Activate
　End If
End Sub

補足

ありがとうございます
説明不足で申し訳ございません
同名のシートがあれば追加しないです。

同名のエラーや文字数の超過など個別に
チェックする方法は難しいのでしょうか？

回答No.1

merlionXX

いちいちシート名をチェックしなくともエラーを回避すればいいのですよね？

Sub Macro1()
x = InputBox("シート名")
On Error GoTo line
Worksheets.Add.Name = x
Exit Sub

line:
MsgBox "すでに同名のシートがあるか、名前が不適切です。"
End Sub

これで、同名のエラーや文字数超過、不適切な文字列の使用を排除できます。

補足

ありがとうございます。

同名のエラーや文字数の超過など個別に
チェックする方法は難しいのでしょうか？