行移位后MSForms.ListBox显示异常的技术问题排查

算力阿峰

2026-6-13

MSForms.ListBox 视觉渲染异常问题

这是一个视觉Bug：ListBox无法正确渲染预期值——在代码其他部分访问特定列或使用Debug.Print打印时能显示正确值，但无法强制ListBox重新正确渲染。我编写了MoveListBoxRow函数，用于根据用户输入重排行：

Sub MoveListBoxRow(lst As MSForms.ListBox, _
                   fromIndex As Long, toIndex As Long, _
                   Optional startColumn As Integer = 0)
    Dim i As Long, colCount As Long
    Dim rowData() As Variant
    Dim totalRows As Long

    totalRows = lst.ListCount
    colCount = lst.ColumnCount

    'fromIndex = fromIndex - 1
    toIndex = toIndex - 1
    If fromIndex = toIndex Or fromIndex < 0 Or toIndex < 0 _
        Or fromIndex >= lst.ListCount Or toIndex >= lst.ListCount Then
        MsgBox "Nueva posicion NO valida", vbExclamation
        'Debug.Print toIndex
        'Debug.Print fromIndex
        'Debug.Print lst.ListCount
        Exit Sub
    End If

    If fromIndex = toIndex Then Exit Sub ' Nothing to move

    ' Store the row data
    ReDim rowData(0 To colCount - 1)
    For i = 0 To colCount - 1
        rowData(i) = lst.List(fromIndex, i)
    Next i

    ' Remove original row
    lst.RemoveItem fromIndex

    ' Adjust target index if needed (since list shifts after removal)
    If fromIndex < toIndex Then toIndex = toIndex - 1

    ' Add item at the new position
    lst.AddItem rowData(0), toIndex
    For i = 1 To colCount - 1
        lst.List(toIndex, i) = rowData(i)
    Next i

    ' Optionally reselect the moved item
    lst.ListIndex = toIndex
End Sub

我通过按钮调用该函数：

Private Sub btnMover_Click()
btnMover.Enabled = False
If lstPasos.ListIndex <> -1 Then
    Dim toIndex As Integer
    toIndex = InputBox("Ingrese Nueva posicion", "Mover a posicion")
    If Not IsNumeric(toIndex) Then Exit Sub
    'Debug.Print toIndex
    DataLoader.MoveListBoxRow Me.lstPasos, lstPasos.ListIndex, CInt(toIndex)
    
End If
'updateRowNumber
DoEvents
updateRowNumber
DoEvents
Me.Repaint

btnMover.Enabled = True
End Sub

用于重新编号行的函数如下：

Sub updateRowNumber()
    Dim i As Long

    ' Ensure we have a valid ListBox and it contains data
    If Me.lstPasos.ListCount > 0 Then
        ' Loop through each row in the ListBox
        
        For i = 0 To Me.lstPasos.ListCount - 1
        Debug.Print i
            Debug.Print Me.lstPasos.List(i, 0) & " " & Me.lstPasos.List(i, 3)
            ' Set the first column (index 0) to the row number (starting from 1)
            Me.lstPasos.List(i, 0) = i + 1
            Debug.Print Me.lstPasos.List(i, 0) & " " & Me.lstPasos.List(i, 3)
        Next i
    End If
End Sub

调试打印输出：

0 
27 SUAVIZADO/CHECK PH=6.5
1 SUAVIZADO/CHECK PH=6.5
 1 
1 TRITON (PROD P/ACAB)
2 TRITON (PROD P/ACAB)
 2 
2 BLANQUEO QUIMICO  PH 12
3 BLANQUEO QUIMICO  PH 12
 3 
3 AQUABRIL JET
4 AQUABRIL JET
 4 
4 DESENGRASANTE LF
5 DESENGRASANTE LF
 5 
5 POTASA CAUSTICA
6 POTASA CAUSTICA
 6 
6 AGUA OXIGENADA
7 AGUA OXIGENADA
 7 
7 ANTIQUIEBRE LF
8 ANTIQUIEBRE LF
 8 
8 SINARWHITE 3BY-N
9 SINARWHITE 3BY-N
 9 
9 NEUTRALIZADO
10 NEUTRALIZADO
 10 
10 ACIDO ACETICO
11 ACIDO ACETICO
 11 
11 PEROXFIN (ELIMINADOR DE PEROX)
12 PEROXFIN (ELIMINADOR DE PEROX)
 12 
12 K-ZIME N/A (ANTIPILLING)
13 K-ZIME N/A (ANTIPILLING)
 13 
13 TINTURA/CHECK PH=7-7.5
14 TINTURA/CHECK PH=7-7.5
 14 
14 SECUESTRANTE MFP
15 SECUESTRANTE MFP
 15 
15 DISPERTEX RE-800
16 DISPERTEX RE-800
 16 
16 ANTIQUIEBRE LF
17 ANTIQUIEBRE LF
 17 
17 CORAFIX RED ME4B 150%
18 CORAFIX RED ME4B 150%
 18 
18 MASOFIX BLUE BRS
19 MASOFIX BLUE BRS
 19 
19 SAL PDV REFINADA
20 SAL PDV REFINADA
 20 
20 ALCALIGENO RS
21 ALCALIGENO RS
 21 
21 POTASA CAUSTICA
22 POTASA CAUSTICA
 22 
22 NEUTRALIZADO
23 NEUTRALIZADO
 23 
23 ACIDO ACETICO
24 ACIDO ACETICO
 24 
24 PRIMER JABONADO
25 PRIMER JABONADO
 25 
25 JABONADOR LF NUEVO 
26 JABONADOR LF NUEVO 
 26 
26 ANTIQUIEBRE LF
27 ANTIQUIEBRE LF

ListBox窗体显示异常：第一列的序号未更新为连续的1、2、3...，仍保留重排前的原始编号（例如显示27、1、2...而非1、2、3...）。

补充说明
针对数据初始加载方式的疑问，数据通过以下子程序加载，接收来自VBA-Web库的Dictionary集合：

Private Sub btnImportarReceta_Click()
    Dim pasos As Collection
    Dim detalle As Dictionary
    Dim paso As Dictionary
    Set receta_id = CreateObject("Scripting.Dictionary")
    costoTotal = 0#
    receta_id.Add "receta_id", txtNroReceta.Value
    'MsgBox TypeName(getDetalleRecetaReceta(receta_id))
    Set detalle = getDetalleReceta(receta_id)
    If detalle Is Nothing Then
        MsgBox "No se encontró el N° receta"
        Exit Sub
    End If
    
    lblColorTono.Caption = detalle("color_tono")
    pk_color_x_cliente = detalle("fk_color_x_cliente")
    cboArticulo.Value = detalle("fk_tipo_articulo")
    cboTeñido.Value = detalle("fk_tenido")
    txtFibra.Value = detalle("fibra")
    Me.cboTipoReceta = detalle("fk_tipo_receta")
    
    If Not IsObject(detalle("pasos")) Then
        MsgBox "No se encontron pasos o insumos"
    Else
        lstPasos.Clear
        antipillingOFF
        'lstPasos.ColumnWidths = "20;0;0;20;40;20,20"
        Set pasos = detalle("pasos")
        For Each paso In pasos
            frmReceta.lstPasos.AddItem paso("orden")  ' First column nro paso
            frmReceta.lstPasos.List(frmReceta.lstPasos.ListCount - 1, 1) = paso("tipo") ' Second column tipo de componente paso(1) insumo(2)
            frmReceta.lstPasos.List(frmReceta.lstPasos.ListCount - 1, 2) = paso("fk") ' Third column pk_insumo/pk_paso
            frmReceta.lstPasos.List(frmReceta.lstPasos.ListCount - 1, 3) = paso("nombre") ' Fourth column nombre
            frmReceta.lstPasos.List(frmReceta.lstPasos.ListCount - 1, 4) = Validaciones.NzAlt(paso("cantidad"))  ' Fifth cantidad
            frmReceta.lstPasos.List(frmReceta.lstPasos.ListCount - 1, 5) = Validaciones.NzAlt(paso("medida"))   'Sixth unidad
            'Debug.Print Validaciones.NzAlt(paso("medida"))
            If paso("tipo") = 2 Then
                If paso("fk") = 19 Then antipillingON
            'Debug.Print Format(Validaciones.NzAlt(paso("costo")), "0.000000")
            frmReceta.lstPasos.List(frmReceta.lstPasos.ListCount - 1, 6) = Format(Validaciones.NzAlt(paso("costo")), "0.000000") 'Format(Validaciones.NzAlt(paso("costo")), "0.000000")
            'lblCostoValue = Me.lblCostoValue.Caption + Validaciones.NzAlt(paso("costo"))
            costoTotal = costoTotal + Validaciones.NzAlt(paso("costo"))
            Else
            frmReceta.lstPasos.List(frmReceta.lstPasos.ListCount - 1, 6) = Validaciones.NzAlt(paso("costo"))
            End If
            
        Next paso
    End If
    btnImportarReceta.Enabled = False
End Sub

内容的提问来源于stack exchange，提问作者Cbas G