| 
            
  サンプルファイル 
 
  
 
 
 
 Dim myFlag As Boolean
 
 
 
 Private Sub CommandButton1_Click()
 
 
 
 
 If ListBox1.ListIndex >= 0 Then
 
 msg = MsgBox("シートを作成します。", vbYesNo)
 
 If msg = vbYes Then
 
 myFlag = True
 
 Call chkShet     'シートの重複チェック
 
 If myFlag = True Then
 Worksheets.Add after:=Sheets(ListBox1.Text) 'シートを追加
 ActiveSheet.Name = TextBox1.Text            'シート名変更
 Call uFInit
 MsgBox "シートを作成しました。"
 End If
 
 End If
 
 End If
 
 
 
 End Sub
 
 
 Sub chkShet()
 
 'シートの重複チェック
 
 Dim myShNameA As String
 Dim myShNameB As String
 
 Dim i As Long
 
 
 myShNameA = TextBox1.Text
 
 
 For i = 1 To Worksheets.Count               'シートの数だけ繰り返す
 
 
 myShNameB = Worksheets(i).Name       '取得したシート名
 
 If myShNameA = myShNameB Then
 
 myFlag = False
 
 MsgBox "シート名が重複しています。"
 Exit For
 
 
 End If
 
 
 Next
 
 
 End Sub
 
 Private Sub ListBox1_Click()
 
 
 On Error Resume Next    '選択したシート名へ移動
 
 Worksheets(ListBox1.Text).Select
 Cells(1, "A").Select
 
 
 
 
 End Sub
 
 Private Sub UserForm_Initialize()
 
 
 
 Call uFInit
 
 
 End Sub
 Sub uFInit()
 
 
 
 On Error Resume Next
 
 ListBox1.Clear
 
 For i = 1 To Worksheets.Count               'シートの数だけ繰り返す
 ListBox1.AddItem Worksheets(i).Name      '取得したシート名をリストボックスへ
 Next
 
 
 ListBox1.ListIndex = 0
 
 
 End Sub
 
 
 
 
 
 
 |