【Access小品】记录顺序调整示例

todaynew

Public Sub MoveRecord(ByVal TableName As String, ByVal KeyName As String, _
               ByVal CurrentKey As Long, ByVal Orientation As Integer, ByVal FormName As String)
    '功能：移动记录位置
    '参数：TableName -- 数据表名称
    '      KeyName -- 主键名称（主键应为自动编号类型）
    '      Currentkey -- 窗体中主键当前值
    '      Orientation -- 移动方向（0=向前，1=向后）
    '      FormName -- 窗体名称
   
    Dim rs As New ADODB.Recordset
    Dim ssql As String
    Dim i As Long
    Dim val0(), val1()
    ssql = "select * from " & TableName
    rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.Find (KeyName & "=" & CurrentKey)
    ReDim val0(rs.Fields.Count - 1)
    ReDim val1(rs.Fields.Count - 1)
    For i = 1 To UBound(val0)
        val0(i) = rs.Fields(i).Value
    Next
    If Orientation = 0 Then
        '前移
        rs.MovePrevious
        If rs.BOF = False Then
            For i = 1 To UBound(val0)
                val1(i) = rs.Fields(i).Value
                rs.Fields(i).Value = val0(i)
            Next
            rs.MoveNext
            For i = 1 To UBound(val0)
                rs.Fields(i).Value = val1(i)
            Next
            rs.Update
        End If
    Else
        '后移
        rs.MoveNext
        If rs.EOF = False Then
            For i = 1 To UBound(val0)
                val1(i) = rs.Fields(i).Value
                rs.Fields(i).Value = val0(i)
            Next
            rs.MovePrevious
            For i = 1 To UBound(val0)
                rs.Fields(i).Value = val1(i)
            Next
            rs.Update
        End If
    End If
    Forms(FormName).Refresh
    rs.Clone: Set rs = Nothing
End Sub


Public Sub InsetRecord(ByVal TableName As String, ByVal KeyName As String, _
               ByVal CurrentKey As Long, ByVal Orientation As Integer, ByVal FormName As String)
    '功能：插入空白记录
    '参数：TableName -- 数据表名称
    '      KeyName -- 主键名称（主键应为自动编号类型）
    '      Currentkey -- 窗体中主键当前值
    '      Orientation -- 插入方向（0=向前，1=向后）
    '      FormName -- 窗体名称
    Dim rs As New ADODB.Recordset
    Dim ssql As String
    Dim id As Long
    ssql = "select * from " & TableName
    rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.AddNew
    rs.Update
    id = rs.Fields(KeyName).Value
    '前插
    Do While rs.Fields(KeyName).Value <> CurrentKey
        If rs.BOF = True Then Exit Do
        Call MoveRecord(TableName, KeyName, id, 0, FormName)
        rs.MovePrevious
        id = rs.Fields(KeyName).Value
    Loop
        
    If Orientation = 1 Then
        '后插
        Call MoveRecord(TableName, KeyName, CurrentKey, 1, FormName)
    End If
    Forms(FormName).Requery
    rs.Clone: Set rs = Nothing
End Sub

tmtony

坐个沙发

xuwenning

还好板凳还在

轻风

只好坐地板了

竹笛

{:soso_e179:}

5574916

好作品，顶上！

efcndi

高手 学习了

软件下载

todaynew老大，我借用了你的这个代码，非常不错。有几个小问题请教一下：

1。在前插和后插之后，requery会导致光标直接回到第一条记录，我用了docmd.gotorecord把光标移动原先被插入的记录处，解决了这个问题。

2。在第一个问题的基础上，如果窗体当前记录较多（有垂直滚动条），在“前插”后，新的记录直接会显示在窗体的最上面。我希望整个窗体显示的记录顺序不要乱，就在前插或后插的地方多出一条空记录，请问如何实现。

第2个问题描述得不知道准不准，看下面：

比如窗体当前显示的记录如下：其中记录1和记录6以后的记录都没显示，在滚动条之外。

...
记录2     内容2
记录3     内容3
记录4     内容4
记录5     内容5
记录6     内容6
...

我要在记录5前插一条，希望窗体显示成

...
记录2     内容2
记录3     内容3
记录4     内容4
记录5     新插入的记录
记录6     内容5
...

但实际上却显示成
...
记录5     新插入的内容
记录6     内容5
记录7     内容6
记录8     内容7
记录9     内容8
...

记录5变成最上面一条了。

请问这个如何解决？用refresh肯定不行，新增加的记录显示后，下面的记录显示不出来。

软件下载

找到一个Seltop属性有点象回事，可测试了几次，不知道这个属性到底是如何排列的，有时用me.seltop=2，结果最上面显示的是第1条，第2条倒是有焦点。有时用me.seltop=6，结果最上面显示的就是第6条，好像和一页显示多少条记录有关。

todaynew

软件下载 发表于 2013-9-2 21:09
找到一个Seltop属性有点象回事，可测试了几次，不知道这个属性到底是如何排列的，有时用me.seltop=2，结果 ...

你说的问题是控制垂直滚动条了，这个我没试过，不知道Access中是否有办法实现。