'=========================================================================================
' 394 リストボックスのリンクするセルを設定・クリアする
'-----------------------------------------------------------------------------------------
'【ヒント】
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim 表示範囲 As String
Dim シート名 As String
Dim リストボックス名 As String
Dim リンクセル As String
Dim 初回 As Integer
Dim 有効 As Integer
Dim タイトル As String
Dim スタイル As Long
Dim メッセージ As String
Dim 応答 As Variant



'=========================================================================================
Private Sub リストボックスのリンクするセルをセットする()
    書き方1                                     '書き方1を使っているが、書き方2、3でもよい
End Sub
'=========================================================================================
' 書き方1〜3は、ワークシートがアクティブでなくても実行可能
'----------------------------------------------------------------------------------------
Sub 書き方1()
    Worksheets("Title").ListBoxes(1).LinkedCell = "呼出!$A$2"
End Sub
'----------------------------------------------------------------------------------------
Private Sub 書き方2()
    Worksheets("Title").DrawingObjects("リスト 1").LinkedCell = "呼出!$A$2"
End Sub
'----------------------------------------------------------------------------------------
Private Sub 書き方3()
    Worksheets("Title").DrawingObjects("リスト 1").Select
    With Selection
        .ListFillRange = "管理表!A2:A4"
        .LinkedCell = "呼出!$A$2"
    End With
End Sub
'=========================================================================================
' 書き方4〜5は、ワークシートがアクティブなら実行可能
'----------------------------------------------------------------------------------------
Private Sub 書き方4()
    ActiveSheet.ListBoxes(1).LinkedCell = "呼出!$A$2"
End Sub
'----------------------------------------------------------------------------------------
Private Sub 書き方5()
    ActiveSheet.DrawingObjects("リスト 1").LinkedCell = "呼出!$A$2"
End Sub
'----------------------------------------------------------------------------------------
Private Sub 書き方6()
    ActiveSheet.DrawingObjects("リスト 1").Select
    With Selection
        .ListFillRange = "管理表!A2:A4"
        .LinkedCell = "呼出!$A$2"
    End With
End Sub
'=========================================================================================
' 書き方11〜13は、書き方1〜3を変数で記述したい場合
'----------------------------------------------------------------------------------------
Private Sub 書き方11()
    シート名 = "Title"                       'リストボックスがあるシートの名前
    リンクセル = "呼出!$A$2"
    Worksheets(シート名).ListBoxes(1).LinkedCell = リンクセル
End Sub
'----------------------------------------------------------------------------------------
Private Sub 書き方12()
    シート名 = "Title"
    リストボックス名 = "リスト 1"               'リストボックスの名前
    リンクセル = "呼出!$A$2"
    Worksheets(シート名).DrawingObjects(リストボックス名).LinkedCell = リンクセル
End Sub
'----------------------------------------------------------------------------------------
Private Sub 書き方13()
    シート名 = "Title"
    リストボックス名 = "リスト 1"
    表示範囲 = "管理表!A2:A4"
    リンクセル = "呼出!$A$2"
    Worksheets(シート名).DrawingObjects(リストボックス名).Select
    With Selection
        .ListFillRange = 表示範囲
        .LinkedCell = リンクセル
        .Display3DShading = True
    End With
End Sub
'=========================================================================================



'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    If 初回 = 1 Then
        GoTo リスタートは不可
    End If
    初回 = 1
    Sheets("呼出").Select
        Range("A2").Select                      'カーソルを位置付ける
        おためしメッセージを表示する
    Sheets("Title").Select
    Exit Sub
'
リスタートは不可:
    リスタート不可メッセージを表示する
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        'ブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためしメッセージを表示する()
    タイトル = "500連発 第2弾 サンプルマクロ"
    スタイル = 64                               'vbInformation
    メッセージ = "現在、リンクするセルがクリアされているので、" & Chr(13) & Chr(13) & _
            "A2セルには何も映っていません。" & Chr(13) & Chr(13) & _
            "OKボタンをクリックしてから、" & Chr(13) & Chr(13) & _
            "リストボックスの任意の項目を、クリックしてみてください"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Private Sub リスタート不可メッセージを表示する()
    スタイル = 16                               'vbCritical
    メッセージ = "リスタートはできません。" & Chr(13) & Chr(13) & _
                "ブックを開き直してください"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'----------------------------------------------------------------------------------------
Sub 環境リストボックスでクリックされた()
    Sheets("呼出").Select
    If 有効 <> 1 Then                           'リンクセルが有効でなければ
        有効 = 1
        メッセージ = "リンクするセルがクリアされたままなので、" & Chr(13) & Chr(13) & _
                "A2セルの内容は更新されていません"
        応答 = MsgBox(メッセージ, スタイル, タイトル)
'
        メッセージ = "OKボタンをクリックすると、" & Chr(13) & Chr(13) & _
                "A2セルを「リンクするセル」としてセットします"
        応答 = MsgBox(メッセージ, スタイル, タイトル)
'
    Sheets("Title").Select
        ActiveSheet.Unprotect                   'シートの保護を解除する
        リストボックスのリンクするセルをセットする '★★★
        ActiveSheet.Protect DrawingObjects:=True, _
            Contents:=True, Scenarios:=True     'シートを保護する
        メッセージ = "OKボタンをクリックしてから、" & Chr(13) & Chr(13) & _
                "リストボックスの未選択項目を、クリックしてみてください"
        応答 = MsgBox(メッセージ, スタイル, タイトル)
    Else
        メッセージ = "リンクするセルがセットされているので、" & Chr(13) & Chr(13) & _
                "A2セルの内容が更新され、リストボックスで" & Chr(13) & Chr(13) & _
                "選択された行数が表示されています"
        応答 = MsgBox(メッセージ, スタイル, タイトル)
    End If
    Worksheets("Title").Select
    Range("P17").Select                        'カーソルを定位置へ移動する
End Sub
'-----------------------------------------------------------------------------------------
Sub Auto_Close()
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------