サンプルファイル
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
|