【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
    1234567
    891011121314
    15161718192021
    22232425262728
    293031    
    << October 2017 >>

    profile

    others

    mobile

    qrcode