シート名を簡単に書く方法があれば教えてください。

シート名を簡単に書く方法があれば教えてください。
シート名が長い場合など、シートの名前を変更するのが煩わしいので、下記のようなマクロを作りました。
この場合、シートのB2とB3に、変更後の名前と変更前の名前を書くことだけなので、他からコピーもできるし、長い文字も簡単に書けます。ただ、うまくいくときとうまくいかない時があり、うまくいかない時は　
　　実行時エラー9　　　インデックスが有効範囲にありません
となります。

マクロの内容は

Sub ■■シート名の変更方法()
'
' ■シート名の変更方法

'1.現状のシート名をRange("B3")に書きます。
'2.変更したい名前をRange("B2")に書きます。

'3.この　■■シート名の変更方法　を実施します｡


Dim myrng1 As Range
Dim myrng2 As Range

Set myrng1 = Range("B3")

Set myrng2 = Range("B2")



Sheets("" & myrng1 & "").Name = "" & myrng2 & ""

' Range("B3") = ""
' Range("B2") = ""

End Sub

です。
該当シートの、Ｂ３に現在のシート名、Ｂ２に変更したいシート名を書いて実行します。

できることもあるのですが・・・。
よろしくお願いいたします。

No.4 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/08/24 19:02

エラーが発生する理由は、他の回答者の方々の指摘通りです。

以下のマクロは、
エラーが発生する要因をチェックして、エラーが発生する可能性がある場合、その理由をメッセージボックスに表示します。
従って、エラーがメッセージボックスに表示されない場合は、
正常にシート名が変更されます。
以下のマクロを使用してみてください。

もし、このマクロを使用しても、
"実行時エラー9　　　インデックスが有効範囲にありません"
等のエラーが発生する場合は、その旨、返信ください。

Public Sub シート名変更()
Dim sname0 As String '変更前シート名
Dim sname1 As String '変更後シート名
Dim ws As Worksheet
Dim ts As Worksheet
Dim estr As String
Set ws = ActiveSheet
sname0 = ws.Range("B3").Text
sname1 = ws.Range("B2").Text
If check_exist(sname0) = False Then
Call errorp("B3", sname0, "このシートは存在しません")
End If
sname1 = Trim(sname1)
If sname1 = "" Then
Call errorp("B2", sname1, "空白です")
End If
If Len(sname1) > 31 Then
Call errorp("B2", sname1, "31文字を超えています")
End If
If check_char_code(sname1, estr) = False Then
Call errorp("B2", sname1, "不正な文字(" & estr & ")を使用しています")
End If
If check_exist(sname1) = True Then
Call errorp("B2", sname1, "このシートは既に存在します")
End If
Set ts = Worksheets(sname0)
ts.Name = sname1
MsgBox ("変更完了")
End Sub
Private Sub errorp(addr, sname, msg)
Dim msg0 As String
msg0 = "シート名不正 " & addr & ":" & sname & vbLf & "不正理由:" & msg
MsgBox (msg0)
End
End Sub
Private Function check_exist(ByVal sname As String) As Boolean
check_exist = True
Dim ws As Worksheet
On Error GoTo ERROR99
Set ws = Worksheets(sname)
Exit Function
ERROR99:
check_exist = False
End Function
Private Function check_char_code(ByVal sname As String, ByRef estr As String) As Boolean
check_char_code = True
Dim sp_chars As Variant
Dim i As Long
Dim wc As String
sp_chars = Array(":", "\", "?", "[", "]", "/", "*", "'")
For i = 0 To UBound(sp_chars)
wc = sp_chars(i)
If InStr(1, sname, wc, vbTextCompare) > 0 Then
estr = wc
check_char_code = False
Exit Function
End If
Next
End Function

この回答へのお礼

ありがとうございます。
貴重なマクロ、大変助かります。
原因が半角スペースだったようで、今は一応解決しましたが、今後も起こる可能性があるので、このマクロ大いに利用させていただきます。
本当にありがとうございました。

お礼日時：2023/08/25 02:07

No.3 回答者： goomania 回答日時： 2023/08/24 13:42

>実行時エラー9　　　インデックスが有効範囲にありません となります。

とのことですが、ご質問者のコードを見て、最初に思いついたのは、シート名が「2023年7月」というシート名を「2023年8月」というシート名に変更するケースです。

この場合、B3に「2023年7月」と入力すると、セルの中身は「2023/7/1」となってしまうので、

Sheets("" & myrng1 & "").Name = "" & myrng2 & ""

というコードを実行しようとすると、シート名が見つからないという意味で「インデックスが有効範囲にありません」となります。

これを防ぎ、月日のようなシリアル値の絡む名前や表示形式を使った名前であっても、見えているとおりに名前変更を行うために、上記コードを

Sheets(myrng1.Text).Name = myrng2.Text

とすればよいのではないかと思います。

この回答へのお礼

ありがとうございます。
どうも半角スペースが混じっていたようです。
ご回答にある日付の問題も今後出てきそうなので、参考にさせていただきます。
ありがとうございました。

お礼日時：2023/08/25 02:01

No.2 回答者： fujillin 回答日時： 2023/08/24 13:05

こんにちは

無条件で入力値を採用しているので、おかしな値を入力すればエラーになる可能性は充分にあります。

＞実行時エラー9　　　インデックスが有効範囲にありません
一番ありそうなのは、「指定された名前のシートが存在しない」ケースでしょうか？
例えば、正しく指定しているつもりでも、セルの最後にスペースが入っているとか、セル内改行コードがついていて気が付かないとか。
あるいは、英数記号などの半角、全角の違いでも正しく入力されていなければ、「シートは存在しない」となります。

その他にも、シート名には使用できない文字や文字数の制限等もありますので、それらに該当すればrename時にエラーとなるでしょう。
また、既に存在するシート名と同じ名前に変えようとしても同様です。


エラーを起こしたくなければ、入力値を事前にきちんとチェックする必要があると思われます。
　・指定されたシート名の文字数が制限値以下か
　・シート名に使用できない文字が含まれていないか
　・変更前のシート名のシートは存在しているか
　・変更後のシート名のシートが、既に存在してはいないか
など。

この回答へのお礼

ありがとうございました。
調べてみたら、半角が混じっていた可能性がありました。
今は治っていますので、今度なったら、再度確認いたします。

お礼日時：2023/08/25 01:56

No.1 回答者： kigoshi 回答日時： 2023/08/24 12:57

シート名に付けられない文字が入っていたり、文字数が長すぎたりしてませんか？

https://aprico-media.com/posts/3180

この回答へのお礼

ありがとうございました。
非常に参考になりました。
これで確認いたします。

お礼日時：2023/08/25 01:56