【VBA】フォームに独自プロパティを設定し表示/非表示を切り替える

0

    <機能>
    (1)ユーザフォームの独自プロパティ(boolean型)をProperty Let、Property Getで操作します
    (2)プロパティがTrueのときリストボックスを表示、Falseのとき非表示にします

    表示⇔非表示 切り替えボタン押下イベントでProperty Getの取得値の論理否定をProperty Letでセット

    (3)世界いろいろ雑学ランキング(データの出典:外務省ホームページ)の内容をリストボックスに表示します

    <サンプルデータ>
    外務省ホームページの「世界いろいろ雑学ランキング」より下記データを使用しました
    ・世界の高い山(http://www.mofa.go.jp/mofaj/kids/ranking/mountain.html)
    ・人口の多い国(http://www.mofa.go.jp/mofaj/kids/ranking/jinko_o.html)
    ・世界の長い川(http://www.mofa.go.jp/mofaj/kids/ranking/river.html)
    ・世界の広い湖(http://www.mofa.go.jp/mofaj/kids/ranking/lake.html)

    データの出典:外務省ホームページ「世界いろいろ雑学ランキング」
    http://www.mofa.go.jp/mofaj/kids/ranking/index.html


    <使い方>
    (1)ユーザフォームを追加
    (ユーザフォームのHeightプロパティを316にセット)
    フォームイメージ、Property Let、Property Get、VBA
    (2)ユーザフォームに下記を追加(プログラムで使用する赤枠内のみ記載)
    ・コンボボックス:cboSelect
    ・表示⇔非表示 切り替えボタン:btnView
    ・URL表示ラベル:lblUrl
    ・ランキングデータ表示リストボックス:listResult
    (ColunmCountを3、Heightプロパティを175に設定)
    リスト高さとカラム数、Property Let、Property Get、VBA
    (3)フォームにソース全体を貼り付けてください(フォームを右クリック > コードの表示)
    (4)「ユーザフォームの表示()」を呼び出すとフォームが表示されます

    <イメージ>
    リストボックスが非表示のとき(PropertyがFalse)
    リストを非表示、Property Let、Property Get、VBA
    リストボックスが表示されているとき(PropertyがTrue)
    世界の高い山、Property Let、Property Get、VBA

    '//ランキング格納構造体定義

    Private Type SCT_RANKING
        rank As String
        name As String
        data As String
    End Type
    Private ranking() As SCT_RANKING

    '//プロパティ(表示⇔非表示切り替え)
    Private isListVisible As Boolean

    '********************************************
    'ユーザフォームの表示
    '********************************************

    Private Sub ユーザフォームの表示()
        MainForm.Show
    End Sub

    '********************************************
    'ユーザフォームの初期化イベント
    '********************************************

    Private Sub UserForm_Initialize()
        Dim i As Integer

        '//ランキング構造体にデータをセット
        Call SetRankingData

        '//フォームのコンボボックス(cboSelect)に値をセット
        '//ランキング構造体のrank=0のレコードを抽出

        Me.cboSelect.Clear
        For i = 0 To UBound(ranking)
            If ranking(i).rank = "0" Then
                MainForm.cboSelect.AddItem (ranking(i).name)
            End If
        Next

        '//フォームを初期状態にセット
        Me.Height = 135
        isListVisible = False
        Me.lblUrl.Caption = ""
        Me.btnView.Caption = "表示"
        Me.listResult.Clear

        '//コンボボックスの先頭レコードを選択してデータを取得
        Me.cboSelect.ListIndex = 0
        Call SetListData
    End Sub

    '********************************************
    'コンボボックスの選択変更イベント
    '********************************************

    Private Sub cboSelect_Change()
        '//リストボックスの表示データを変更
        Call SetListData
    End Sub

    '********************************************
    'リストボックスの表示データを変更
    '********************************************

    Private Sub SetListData()
        Dim flg As Boolean
        Dim i As Integer, idx As Integer

        '//リストボックスをクリア
        Me.listResult.Clear
        '//カラム幅をセット
        Me.listResult.ColumnWidths = "40pt;140pt;80pt"

        '//コンボボックスの表示データ変更
        '//ランキング構造体のrank=0で2カラム目がコンボのテキストと一致すれば取得開始
        '//次のrank=0が出現、またはranking配列の要素がなくなったら終了

        flg = False
        For i = 0 To UBound(ranking)
            '//データ取得中にrank=0が出現したらデータ取得終了
            If flg And ranking(i).rank = "0" Then Exit For

            '//ランキング構造体のnameとコンボボックスの選択している名称が一致したらデータ取得開始
            If ranking(i).name = Me.cboSelect.Text Then
                flg = True
                Me.lblUrl = ranking(i).data
                GoTo nextrec
            End If

            '//データ読み込み
            If flg Then
                Me.listResult.AddItem
                idx = Me.listResult.ListCount
                Me.listResult.List((idx - 1), 0) = ranking(i).rank
                Me.listResult.List((idx - 1), 1) = ranking(i).name
                Me.listResult.List((idx - 1), 2) = ranking(i).data
            End If
    nextrec:
        Next
    End Sub

    '********************************************
    '表示ボタン押下イベント
    '********************************************

    Private Sub btnView_Click()
        '//右辺のProperty Getで現在の表示フラグ(isListVisible)を表示
        '//右辺の論理否定(Not演算子)値をプロパティにセット(Property Let)

        Me.prListVisible = Not Me.prListVisible
    End Sub

    '********************************************
    'プロパティセット(Let)
    '********************************************

    Property Let prListVisible(isView As Boolean)
        isListVisible = isView
        If isListVisible Then
            Me.Height = 135
            Me.btnView.Caption = "表示"
        Else
            Me.Height = 316
            Me.btnView.Caption = "非表示"
        End If
    End Property

    '********************************************
    'プロパティゲット(Get)
    '********************************************

    Property Get prListVisible() As Boolean
        prListVisible = isListVisible
    End Property

    '********************************************
    'データの出典:外務省ホームページ「世界いろいろ雑学ランキング」
    'http://www.mofa.go.jp/mofaj/kids/ranking/index.html
    'ランキング構造体にデータをセット
    '1カラム目:順位(rank)
    '2カラム目:名称(name)
    '3カラム目:データ(data)
    '※rank=0のときコンボボックスにセットする名称を定義
    '********************************************

    Private Sub SetRankingData()
        Dim ar As Variant
        Dim i As Integer, wkstr() As String

        ar = Array( _
        "0,世界の高い山,http://www.mofa.go.jp/mofaj/kids/ranking/mountain.html", "1,エベレスト(ヒマラヤ),8848m", _
        "2,ゴドウィンオースチン(カラコルム),8611m", "3,カンチェンジュンガ(ヒマラヤ),8586m", "4,ローツェ(ヒマラヤ),8516m", _
        "5,マカルウ(ヒマラヤ),8463m", "6,チョーオユ(ヒマラヤ),8201m", "7,ダウラギリ(ヒマラヤ),8167m", _
        "8,マナスル(ヒマラヤ),8163m", "9,ナンガパルパット(ヒマラヤ),8126m", "10,アンナプルナ(ヒマラヤ),8091m", _
        "日本一,富士山,3776m", _
        "0,人口の多い国,http://www.mofa.go.jp/mofaj/kids/ranking/jinko_o.html", "1,中華人民共和国(中国),13億8560万人", _
        "2,インド,12億5210万人", "3,アメリカ合衆国(米国),3億2010万人", "4,インドネシア,2億4990万人", "5,ブラジル,2億40万人", _
        "6,パキスタン,1億8210万人", "7,ナイジェリア,1億7360万人", "8,バングラデシュ,1億5660万人", "9,ロシア,1億4280万人", _
        "10,日本,1億2710万人", _
        "0,世界の長い川,http://www.mofa.go.jp/mofaj/kids/ranking/river.html", "1,ナイル,6695km", "2,アマゾン,6516km", _
        "3,長江(チャンジャン),6380km", "4,ミシシッピ-ミズーリ-レッドロック,5969km", "5,オビ-イルチシ,5568km", _
        "6,エニセイ-バイカル-セレンガ,5550km", "7,黄河(ホワンホー),5464km", "8,コンゴ(ザイール),4667km", _
        "9,ラプラタ-パラナ,4500km", "10,アムル-アルグン,4444km", "日本一,信濃川,367km", _
        "0,世界の広い湖,http://www.mofa.go.jp/mofaj/kids/ranking/lake.html", "1,カスピ海(ユーラシア),374000平方km", _
        "2,スペリオル湖(北アメリカ),82367平方km", "3,ビクトリア湖(アフリカ中央部),68800平方km", "4,アラル海(中央アジア),64100平方km", _
        "5,ヒューロン湖(北アメリカ),59570平方km", "6,ミシガン湖(北アメリカ),58016平方km", "7,タンガニーカ湖(アフリカ東部),32000平方km", _
        "8,バイカル湖(シベリア),31500平方km", "9,グレートベア湖(カナダ北部),31153平方km", "10,グレートスレープ湖(カナダ北部),28568平方km", _
        "日本一,琵琶湖,670平方km")

        For i = 0 To UBound(ar)
            wkstr = Split(ar(i), ",")

            ReDim Preserve ranking(i)
            ranking(i).rank = wkstr(0)
            ranking(i).name = wkstr(1)
            ranking(i).data = wkstr(2)
        Next
    End Sub

     

    よろしければポチッと押してください

    プログラマー ブログランキングへ



    calendar

    S M T W T F S
          1
    2345678
    9101112131415
    16171819202122
    23242526272829
    30      
    << September 2018 >>

    profile

    others

    mobile

    qrcode         スマホ表示に戻す