Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/18.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
如何在访问VBA时上下移动列表框中的项目?_Vba_Ms Access_Ms Access 2010 - Fatal编程技术网

如何在访问VBA时上下移动列表框中的项目?

如何在访问VBA时上下移动列表框中的项目?,vba,ms-access,ms-access-2010,Vba,Ms Access,Ms Access 2010,我有一个列表框包含10次。我有上下按钮来上下移动物品。仅当我将listbox multiselect属性设置为“无”时,我的VBA才起作用。对于multiselect=simple选项,它会在这行代码中有效使用null时抛出类似的错误 sText = lbfNames.Column(0, iIndex) 我的VBA Private Sub cmdUP_Click() Dim sText As String Dim iIndex As Integer

我有一个列表框包含10次。我有上下按钮来上下移动物品。仅当我将listbox multiselect属性设置为“无”时,我的VBA才起作用。对于multiselect=simple选项,它会在这行代码中有效使用null时抛出类似的错误

     sText = lbfNames.Column(0, iIndex)
我的VBA

    Private Sub cmdUP_Click() 
    Dim sText As String
       Dim iIndex As Integer
       iIndex = lbfNames.ListIndex
       '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
我试图将stackoverflow中的C代码转换为访问VBA抛出错误。找不到某些数据成员

     public void MoveUp()
 {
     MoveItem(-1);
 }

 public void MoveDown()
 {
    MoveItem(1);
 }

 public void MoveItem(int direction)
 {
    // Checking selected item
    if (listBox1.SelectedItem == null || listBox1.SelectedIndex < 0)
        return; // No selected item - nothing to do

    // Calculate new index using move direction
    int newIndex = listBox1.SelectedIndex + direction;

    // Checking bounds of the range
    if (newIndex < 0 || newIndex >= listBox1.Items.Count)
        return; // Index out of range - nothing to do

    object selected = listBox1.SelectedItem;

    // Removing removable element
    listBox1.Items.Remove(selected);
    // Insert it in new position
    listBox1.Items.Insert(newIndex, selected);
    // Restore selection
    listBox1.SetSelected(newIndex, true);
}

在access vba中是否有这样做的方法。

我实际上重建了此设置,但从未得到您提到的错误。我确实对代码进行了调整,以适应您尝试执行的操作。试试这个:

Private Sub cmdup_Click()
Dim sText As String
Dim iIndex As Variant
Dim selection() As Integer
Dim n, topSelection As Integer

' save the indexes of the selected items,
' they will be deselected after the first removal
For Each iIndex In lbfnames.ItemsSelected
    ReDim Preserve selection(0 To n)
    selection(n) = iIndex
    n = n + 1
Next

'loop through all the selected indexes
'this will also ensure you will only proceed if there is a selected item
For n = LBound(selection) To UBound(selection)
    'save items text and items indexvalue
    sText = lbfnames.Column(0, selection(n))

    If selection(n) <= topSelection Then 'index topSelection is top item which can't be moved up!
        MsgBox ("Can not move item '" & sText & "' up any higher.")
        topSelection = topSelection + 1
    Else
        'first remove item from old position
        lbfnames.RemoveItem selection(n)
        'place item back on new position
        lbfnames.AddItem sText, selection(n) - 1
        'change the index of the selected value to the new index (for reselection)
        selection(n) = selection(n) - 1
    End If
Next
'loop through the selection again to reselect
For n = LBound(selection) To UBound(selection)
    lbfnames.Selected(selection(n)) = True
Next
End Sub
我认为代码和注释是不言自明的,但下面是一个快速运行过程:

我首先保存选定的元素索引,因为我注意到 删除/添加选定的元素后 跑了。 然后我运行了这个选择,我在这里重用了您的代码。 更改了弹出消息的条件,因为如果选择 例如,前2个元素表示1和2,您不希望只显示1和2 获取1的messagebox,然后在下一个循环中将2置于1之前。 除非这是您想要的,否则将此条件更改回0 第二次通过选定的元素添加end I循环,以再次选择它们,以便将它们进一步向上移动。
注意:示例C代码为两个运动方向显示了一个更通用的函数。我没有对此进行修改,我认为这是一个好主意,但让您始终实施一个好的练习来理解代码。

下面的代码使用enum是类型安全的。 该解决方案允许在列表中上下移动。 解决方案包装移动,例如,如果在列表顶部并试图向上移动,则将项目包装到底部

Private Enum directions
    down = -1
    up = 1
End Enum

Private Sub cmdDown_Click()
    moveListItem (down)
End Sub

Private Sub cmdMvUp_Click()
    moveListItem (up)
End Sub

Private Sub moveListItem(direction As directions)
    With Me.ListBox1
        Select Case .ListIndex

            ' at bottom and moving down then wrap around to top
        Case Is >= .ListCount + direction
            .AddItem .Column(0, .ListCount - 1), 0
            .RemoveItem (.ListCount - 1)
            .Selected(0) = True

            ' at top and moving up then wrap around to bottom
        Case Is < direction
            .AddItem .Column(0, 0), .ListCount
            .RemoveItem (0)
            .Selected(.ListCount - 1) = True

        Case Else
            .AddItem .Column(0, .ListIndex - direction), .ListIndex + ((direction + 1) / 2)
            .RemoveItem (.ListIndex - direction)
        End Select

    End With
End Sub

如果不想使用环绕功能,请将上述解决方案修改为此

Option Explicit
Private Enum directions
    down = -1
    up = 1
End Enum

Private Sub cmdDown_Click()
    moveListItem (down)
End Sub

Private Sub cmdMvUp_Click()
    moveListItem (up)
End Sub

Private Sub moveListItem(direction As directions)
    With Me.ListBox1
        Select Case .ListIndex
            ' at bottom and moving down then wrap around to top
        Case Is >= .ListCount + direction

            ' at top and moving up then wrap around to bottom
        Case Is < direction

        Case Else
            .AddItem .Column(0, .ListIndex - direction), .ListIndex + ((direction + 1) / 2)
            .RemoveItem (.ListIndex - direction)
        End Select
    End With
End Sub

工作完美!!非常感谢你。对于向下移动的项目,我是否需要更改Else部分中的代码?@sam是的,确实需要更改Else部分中的代码以及topSelection变量,因为现在底部的项目是限制。最简单的方法是尝试调整函数以向下移动,并在其工作时与此函数进行比较,看看如何将它们组合成一个更通用的函数,如您的C示例。试一试,玩一玩,当你陷入困境时问一个新问题。