访问vba代码,在列表框中向上和向下滚动选定项目

时间:2014-02-04 20:31:45

标签: vba access-vba

请任何人帮我这个。 需要访问vba代码,以便在列表框中向上和向下滚动选定的项目。

1 个答案:

答案 0 :(得分:1)

将列表框多选属性设置为'无'

 Private Sub cmdDown_Click()
 Dim sText As String
 Dim iIndex As Integer
 Dim bottomLimit As Integer
 iIndex = lbfNames.ListIndex
 bottomLimit = lbfNames.ListCount - 1
 'check: only proceed if there is a selected item
 If lbfNames.ListCount > 1 Then
     If iIndex >= bottomLimit Then
        MsgBox ("Can not move the item down any further.")
        Exit Sub
    End If
    'save items text and items indexvalue
    sText = lbfNames.Column(0, iIndex)
    If iIndex < bottomLimit Then
        lbfNames.RemoveItem iIndex
        'place item back in new position
        lbfNames.AddItem sText, iIndex + 1
    End If
    'if you keep that item selected
    'you can keep moving it by pressing btnMoveDown
    lbfNames.Selected(iIndex + 1) = True
    iIndex = iIndex + 1
   End If
   End Sub

向上移动

 Private Sub cmdUP_Click()     
 Dim sText As String
 Dim iIndex As Integer
 iIndex = lbfNames.ListIndex
' ReDim iIndex(0 To 10)
 'check: only proceed if there is a selected item
  If lbfNames.ListCount > 1 Then
    'index 0 is top item which can't be moved up!
    If iIndex <= 0 Then
        MsgBox ("Can not move the item up any higher.")
        Exit Sub
    End If
    ' If iIndex = -1 Or lbfNames.ListCount > 1 Then
    'save items text and items indexvalue
    sText = lbfNames.Column(0, iIndex)
    lbfNames.RemoveItem iIndex
    'place item back on new position
    lbfNames.AddItem sText, iIndex - 1
    'if you keep that item selected
    'you can keep moving it by pressing cmdUp
    lbfNames.Selected(iIndex - 1) = True

    iIndex = iIndex - 1

    End If

   End Sub