' [034.xls]



' [Module1] のコード
'★★☆　Excel ウィンドウの表示状態を保存・復元する　☆★★

Option Explicit

Public i As Integer
Public r As Integer

Dim bar As Object

Sub start()

    UserForm1.Show

End Sub

Sub 初期化()
Dim 最終行 As Integer
Dim 最終列 As Integer

    
    'データをすべて消して範囲名(hni名前)を初期化
    With Sheets("お気に入り")
        If .[A6] = "" Then Exit Sub
        最終行 = [A5].End(xlDown).Row
        最終列 = [A5].End(xlToRight).Column
        Range(Cells(5, 1), Cells(最終行, 最終列)).ClearContents
        [A5].Name = "hni名前"
        [A1].ClearContents
    End With
    
    Sheets("Title").Select
    ThisWorkbook.Save

End Sub


' [UserForm1] のコード

Option Explicit

Dim sin As Integer
Dim bar As Object
Dim n_count As Integer

Private Sub ComboBox1_Change()

    With Sheets("お気に入り")
    
        If ComboBox1.Value = "" Then
            CommandButton2.Enabled = False
            MsgBox "名前がありません"
            Exit Sub
        End If
        
        '登録済みかチェックして実行ボタンの使用許可を決める
        .[A1] = ComboBox1.Text
        If IsError(.[a2]) = True Then
            CommandButton2.Enabled = False
        Else
            CommandButton2.Enabled = True
            Me.Caption = "登録済みの状態に戻します"
        End If
        
    End With

End Sub

Private Sub CommandButton1_Click()

    ComboBox1.SetFocus
    
    If ComboBox1.Value = "" Then
        MsgBox "この設定に名前を付けて下さい"
        Exit Sub
    End If
    
    With Sheets("お気に入り")
        
        '新しい名前をセルA1に代入する
        .[A1] = ComboBox1.Text
            
            '名前が今までに登録されている中に無ければ
            'ワークシート内の関数によりセルA2がエラーになります
            If IsError(.[a2]) = True Then
                
                '新規登録する列を決定
                r = .[A3] + 1
            Else
                
                'OK & キャンセルボタン付きMsgBoxを表示
                sin = MsgBox("すでに登録されています、上書しますか？", 33, "登録済みです")
                
                'キャンセルボタンの戻り値は2です
                If sin = 2 Then Exit Sub
                
                '上書する列を決定
                r = .[a2]
                
            End If
            
            '新規名前をセル(行5 で 新規列)に代入
            .Cells(5, r) = ComboBox1.Text
            
            'その結果をすぐにComboBox1にも新規行として登録
            ComboBox1.AddItem .Cells(5, r)
            
            '範囲名(hni名前)を再定義
            Range(.[A5], .Cells(5, r)).Name = "hni名前"
            
            'もしExcelが現在最大表示だったら
            If Application.WindowState = xlMaximized Then
            
                '指定セルに10000を代入
                '(スクリーンサイズではあり得ない数字を指定)
                .Cells(6, r) = 10000
            Else
                
                'Excelが現在最大表示じゃ無かったら指定セルに
                '(高さ、はば、上位置、左位置)を順次代入する
                .Cells(6, r) = Application.Height
                .Cells(7, r) = Application.Width
                .Cells(8, r) = Application.Top
                .Cells(9, r) = Application.Left
            End If
    i = 1
                '現在表示されているメニューバー以外(ツールバーのすべて)
                For Each bar In CommandBars
                    If bar.Visible = True Then
                        If bar.Name <> "Worksheet Menu Bar" Then
                            
                            'を順次、指定セルに代入していく
                            .Cells(i + 9, r) = bar.Name
                            
                            i = i + 1
                        End If
                    End If
                Next
    End With
    
    '記憶した状態を保存
    ThisWorkbook.Save

    Unload Me

End Sub

Private Sub CommandButton2_Click()

    ComboBox1.SetFocus
    
    '名前のチェック
    If ComboBox1.Value = "" Then
        Me.Caption = "名前がありません"
        Exit Sub
    End If
    
    With Sheets("お気に入り")
    
        .[A1] = ComboBox1.Text
            If IsError(.[a2]) = True Then
                MsgBox "登録された名前はありません" & Chr(10) _
                    & "お気に入りに新規登録して下さい"
                Exit Sub
            End If
                
                'チェックを通過した名前をワークシートで判断して列を決定
                r = .[a2]
                
                'セルをチェックして保存時最大表示だった場合
                If .Cells(6, r) = 10000 Then
                    
                    'UserFormを非表示にする
                    '表示されているときは最大表示の命令は無視されるから
                    Me.Hide
                    
                    'Excelを最大表示にする
                    Application.WindowState = xlMaximized
                Else
                    
                        '保存時最大表示ではなく、現在最大表示の時
                        If Application.WindowState = xlMaximized Then
                    
                            'UserFormを非表示にする
                            '表示されているときは最大表示を戻す命令は無視されるから
                            Me.Hide
                        
                            '最大表示を解除
                            Application.WindowState = xlNormal
                        
                        End If
                    
                            'Excelのサイズと位置を保存時の状態にしていく
                            Application.Height = .Cells(6, r)
                            Application.Width = .Cells(7, r)
                            Application.Top = .Cells(8, r)
                            Application.Left = .Cells(9, r)
                    
                End If
                
            '現在表示されているメニューバー以外
            '(ツールバーのすべて)を一旦消してしまう
            For Each bar In CommandBars
                On Error Resume Next
                    If bar.Name <> "Worksheet Menu Bar" Then
                        bar.Visible = False
                    End If
            Next
                On Error GoTo 0
            
            '変数の初期化
            i = 1
                
                '保存時記憶しておいたツールバーを順次セットしていく
                'セルの値が空白になるまで繰り返す
                While .Cells(i + 9, r) <> ""
                    CommandBars(.Cells(i + 9, r).Text).Visible = True
                    i = i + 1
                Wend
    End With
    
    Unload Me
End Sub

Private Sub UserForm_Initialize()

    '各種コントロールの初期化
    Label1.Caption = "名前"
    Me.Caption = "現在のお気に入り設定記憶"
    CommandButton1.Caption = "現在状態をお気に入りに登録"
    CommandButton2.Caption = "復元実行"
    CommandButton2.Enabled = False
    
    '未登録の時は何もせずマクロを抜ける
    If Sheets("お気に入り").[A5] = "" Then Exit Sub
    
    If Sheets("お気に入り").[B5] = "" Then
        
        '登録数が1件の場合は変数 n_count に 1 を格納
        n_count = 1
    Else
        
        '登録数が複数の場合はその件数を調べて変数 n_count に総数を格納
        n_count = Sheets("お気に入り").[A5].End(xlToRight).Column
    End If
    
    With ComboBox1
        .Clear
        .ListRows = 4
        .ColumnWidths = "2cm"
            For i = 1 To n_count
                .AddItem Sheets("お気に入り").Cells(5, i)
            Next i
    End With
    
End Sub