コンボボックスの表示行数を増やすには？ (ID:77763)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

.frm
Option Explicit
Private Sub Command1_Click()
    Dim udtPointForm          As tagPOINT
    Dim udtRectCombo          As tagRECT
    Dim lngComboBoxHeight     As Long
    Dim lngComboBoxWidth      As Long
    Dim lngListItemHeight     As Long
    Dim lngNewCtrlHeight      As Long
    Dim lngGetComponent       As Long
    Dim lngWin32apiResultCode As Long
    ' 変更する構成要素にリストボックスを指定
    lngGetComponent = 0
    With Combo1
        ' シンプルコンボ(標準コンボ)以外で有効
        If .Style <> vbComboSimple Then
            ' コンボボックスの画面上の相対座標を取得
            lngWin32apiResultCode = GetWindowRect(.hwnd, udtRectCombo)
            ' 取得した座標からフォームの相対座標を取得
            udtPointForm.x = udtRectCombo.Left
            udtPointForm.y = udtRectCombo.Top
            lngWin32apiResultCode = ScreenToClient(Form1.hwnd, udtPointForm)
            ' リストボックス項目の高さを取得
            lngListItemHeight = SendMessage(.hwnd, CB_GETITEMHEIGHT, lngGetComponent, _
            ByVal CLng(0))
            ' コンボボックスの高さを取得
            lngComboBoxHeight = .Height \ Screen.TwipsPerPixelX
            ' コンボボックスの幅を取得
            lngComboBoxWidth = .Width \ Screen.TwipsPerPixelY
            ' 新しいサイズを計算
            lngNewCtrlHeight = lngComboBoxHeight + (lngListItemHeight * .ListCount) _
            + (1 * 2)
            ' 新しいサイズで再描画
            lngWin32apiResultCode = MoveWindow(.hwnd, udtPointForm.x, udtPointForm.y, _
            lngComboBoxWidth, lngNewCtrlHeight, CLng(1))
        End If
    End With
End Sub

Private Sub Form_Load()

Dim lngAddItemCount As Long
    Dim i As Integer

Label1.Alignment = vbRightJustify

Label1.Caption = "コンボボックス"

With Combo1
        For lngAddItemCount = 0 To (12 - 1)
        .AddItem (Format(CDate(lngAddItemCount + 1 & "/1"), "mmmm"))
        Next lngAddItemCount
        .ListIndex = 0
    End With
    ' コマンドボタンの初期化
    Command1.Caption = "実行"
End Sub

.bas
Option Explicit

' 点のx座標とy座標を定義する構造体の宣言
    Type tagPOINT
        x As Long
        y As Long
    End Type
    ' 長方形の左上隅と右下隅の座標を定義する構造体の宣言
    Type tagRECT
        Left   As Long
        Top    As Long
        Right  As Long
        Bottom As Long
    End Type
    ' 指定されたウィンドウの位置と寸法を変更する関数の宣言
    Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, _
        ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
        ByVal bRepaint As Long) As Long
    ' 指定されたウィンドウの境界長方形の寸法を取得する関数の
    ' 宣言
    Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, _
        lpRect As tagRECT) As Long
    ' 画面上の指定された点のスクリーン座標をクライアント座標に
    ' 変換する関数の宣言
    Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, _
        lpPoint As tagPOINT) As Long
    ' ウィンドウにメッセージを送る関数の宣言
    Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, _
        ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long
    ' コンボボックスの構成要素の高さを取得することを
    ' 示す定数の宣言
    Public Const CB_GETITEMHEIGHT = &H154

もっと簡単な方法ってないのかな？

←解決時は質問者本人がここをチェックしてください。

戻る