'ダイアログボックスでシートを選択するマクロ

'MakeDialogSheetマクロを実行してダイアログシートを作成した後
'SheetSelectマクロを実行してください。

Option Explicit

Const DialogSheetName = "SheetSelectDialog"

Sub SheetSelect()
    Dim book1 As Object, sheet1 As Object, sheet2 As Object
    Dim s As String
    Dim a() As String
    Dim i As Integer, j As Integer

    If ActiveSheet Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    i = 0
    j = 0
    s = "[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name
    With ThisWorkbook.DialogSheets(DialogSheetName)
        With .ListBoxes(1)
            .RemoveAllItems
            For Each book1 In Workbooks
                If book1.Windows(1).Visible Then
                    For Each sheet1 In book1.Sheets
                        If sheet1.Visible Then
                            i = i + 1
                            ReDim Preserve a(1 To i)
                            a(i) = "[" & book1.Name & "]" & sheet1.Name
                            If s = a(i) Then j = i
                        End If
                    Next
                End If
            Next
            If i > 0 Then
                .List = a
                .ListIndex = j
            End If
        End With
        Set book1 = ActiveWindow
        Set sheet1 = ActiveWindow.SelectedSheets
        Set sheet2 = ActiveSheet
        Application.ScreenUpdating = True
        If Not .Show Then
            Application.ScreenUpdating = False
            book1.Activate
            sheet1.Select
            sheet2.Activate
            Application.ScreenUpdating = True
        End If
    End With
End Sub

Sub List1_Change()
    Dim s As String
    Dim i As Integer
    Application.ScreenUpdating = False
    With ActiveDialog.DrawingObjects(Application.Caller)
        s = .List(.ListIndex)
    End With
    For i = Len(s) To 1 Step -1
        If Mid$(s, i, 1) = "]" Then Exit For
    Next
    Workbooks(Mid$(s, 2, i - 2)).Activate
    Sheets(Mid$(s, i + 1)).Select
    Application.ScreenUpdating = True
End Sub

Sub MakeDialogSheet()
    Dim dlg As DialogSheet
    Dim gw As Double
    Set dlg = DialogSheets.Add
    With dlg
        .Name = DialogSheetName
        gw = .Buttons(1).Height / 3
        .DialogFrame.Left = gw * 13
        .DialogFrame.Top = gw * 4
        .DialogFrame.Width = gw * 61
        .DialogFrame.Height = gw * 30
        .DialogFrame.Caption = StrConv("シートの選択", vbNarrow)
        .DrawingObjects.Delete
    End With
    With dlg.Labels.Add(Left:=gw * 14, Top:=gw * 7, _
            Width:=gw * 25, Height:=gw * 3)
        .Accelerator = "a"
        .Caption = StrConv("シート", vbNarrow)
    End With
    With dlg.ListBoxes.Add(Left:=gw * 14, Top:=gw * 10, _
            Width:=gw * 48, Height:=gw * 23)
        .OnAction = "List1_Change"
    End With
    With dlg.Buttons.Add(Left:=gw * 63, Top:=gw * 8, _
            Width:=gw * 10, Height:=gw * 3)
        .Caption = "OK"
        .DismissButton = True
        .DefaultButton = True
    End With
    With dlg.Buttons.Add(Left:=gw * 63, Top:=gw * 12, _
            Width:=gw * 10, Height:=gw * 3)
        .Caption = StrConv("キャンセル", vbNarrow)
        .CancelButton = True
    End With
End Sub