おおぞらのとんび

----------以下をUserForm1へコピペ----------

Private Sub ListView1_Click()

    Dim pntPos As POINTAPI
    Dim sglPosX, sglPosY As Single

    Dim intColWid As Integer
    Dim intColCnt As Integer

    'sglLVposL Frame1の左端位置
    'sglLVposR Frame1の右端位置
    'sglLVposA セル列の左端
    'sglLVposB セル列の右端
    Dim sglLVposL, sglLVposR, sglLVposA, sglLVposB As Single

    Dim i As Integer

    'スクロールバーを一度消さないと、なぜかバーが初期値になる←を解除
    Frame1.ScrollBars = fmScrollBarsBoth

    Call GetCursorPos(pntPos)

    'ピクセルからポイントへ変換
    sglPosX = pntPos.x * 0.75
    sglPosY = pntPos.y * 0.75

    intColCnt = ListView1.ColumnHeaders.Count

    'Frame1内の左端位置（最後の +5 は枠幅）
    sglLVposL = UserForm1.Left + Frame1.Left + ListView1.Left + 5

    'Frame1内の右端位置（最後の -5 は枠幅 -13はスクロールバー）
    sglLVposR = sglLVposL + Frame1.Width - 5 - 13

    '1列目のセル左端セット（スクロールに対応）
    sglLVposA = sglLVposL - Frame1.ScrollLeft

    '列幅合計用
    intColWid = 0

    For i = 1 To intColCnt
        sglLVposB = sglLVposA + ListView1.ColumnHeaders(i).Width

        'マウス座標が列の幅内か判断
        If (sglLVposA < sglPosX) And (sglLVposB > sglPosX) Then

            If sglLVposA < sglLVposL Then
                'スクロールでクリックセルが左端よりでてる
                Frame1.ScrollLeft = Frame1.ScrollLeft - (sglLVposL - sglLVposA)
            ElseIf (sglLVposB > sglLVposR) And ((sglLVposB - sglLVposA) < (sglLVposR - sglLVposL)) Then
                'スクロールでクリックセルが右端よりでて、列幅がフレーム幅より小さい
                Frame1.ScrollLeft = Frame1.ScrollLeft + (sglLVposB - sglLVposR)
            End If

            '入力用テキストボックスサイズ
            TextBox1.Width = sglLVposB - sglLVposA
            Frame2.Width = sglLVposB - sglLVposA

            'セル番地をグローバル変数に格納
            GLB_INT_COL = i - 1
            GLB_INT_ROW = ListView1.SelectedItem.Index

            '列の座標（最後の +2 は微調整）
            Frame2.Left = intColWid + 2
            '行の座標　見出厚+3
            Frame2.Top = 3 + (ListView1.SelectedItem.Index * (CST_INT_FSIZE + CST_INT_FCFCT))

            '入力用ボックスの値セット
            If GLB_INT_COL = 0 Then
                TextBox1.Text = CStr(ListView1.ListItems(GLB_INT_ROW).Text)
            Else
                TextBox1.Text = CStr(ListView1.ListItems(GLB_INT_ROW).SubItems(GLB_INT_COL))
            End If

            '入力用ボックス表示
            Frame2.Visible = True
        End If
        sglLVposA = sglLVposB
        intColWid = intColWid + ListView1.ColumnHeaders(i).Width
    Next i
    '列幅、行追加対応
    subFrmSclSet
End Sub

'ListViewの全列幅、行追加でサイズ変更
Private Sub subFrmSclSet()
    Dim i As Integer
    Dim sglWid As Single
    Dim sglHig As Single

    '横幅
    sglWid = 0
    For i = 1 To ListView1.ColumnHeaders.Count
        sglWid = sglWid + ListView1.ColumnHeaders(i).Width
    Next
   
    ListView1.Width = sglWid
    Frame1.ScrollWidth = sglWid

    'スクロールバーの修正を利用して列縮小時の右端表示対応
    If Frame1.ScrollLeft > 1 Then
        Frame1.ScrollLeft = Frame1.ScrollLeft - 1
        Frame1.ScrollLeft = Frame1.ScrollLeft + 1
    End If

    '縦幅
    '見出厚+3　　行数（+2は見出と1行余裕をみる）
    sglHig = 3 + ((ListView1.ListItems.Count + 2) * (CST_INT_FSIZE + CST_INT_FCFCT))
    ListView1.Height = sglHig
    Frame1.ScrollHeight = sglHig

    'スクロールバーの修正を利用して行変化に対応
    If Frame1.ScrollTop > 1 Then
        Frame1.ScrollTop = Frame1.ScrollTop - 1
        Frame1.ScrollTop = Frame1.ScrollTop + 1
    End If

   
End Sub

Private Sub subLvwIniSet()
    Dim i As Integer

    For i = 1 To 100
        '1列目
        ListView1.ListItems.Add Text:=CStr(i)
        '2列目
        ListView1.ListItems(i).SubItems(1) = "aaa"
        '3列目
        ListView1.ListItems(i).SubItems(2) = "あああ"

        '文字に色付ける場合
        'ListView1.ListItems(i).ForeColor = "&H00FF00"
        'ListView1.ListItems(i).ListSubItems(1).ForeColor = "&H00FF00"
        'ListView1.ListItems(i).ListSubItems(2).ForeColor = "&H00FF00"
    Next

    '見出厚+3　　行数（+2は見出と1行余裕をみる）
    ListView1.Height = 3 + ((ListView1.ListItems.Count + 2) * (CST_INT_FSIZE + CST_INT_FCFCT))
End Sub