Rambler's Top100
Российский фонд помощи
Навигация
Главная
MS ACCESS
VB
ASP
PHP
Наши друзья
Поиск
Форум
Лента новостей
Новый сайт

Online
Сейчас на сайте находятся:
1 гость
Рассылки Subscribe.Ru
Работа с MS Access
Подписаться письмом
Реклама на сайте
Доставка (от 149 р.), продажа чая кофе магазин в Москве.
 
Главная arrow MS ACCESS arrow Нумерация строк в ленточной форме и произвольный их порядок по желанию пользователя
Нумерация строк в ленточной форме и произвольный их порядок по желанию пользователя Печать E-mail
Автор АлексейЕ   
03.02.2009 г.

Описание: Частенько пользователь базы данных хочет по своему порядку в табличной часть документа располагать записи.
Для реализации такой возможности требуется:
- поле в таблице, в которой будет указываться номер строки (Number) ;
- ленточная форма с источником строк с сортировкой по полю номера строки;
- две кнопки вверх (cmdUp) и вниз (cmdDown);
- ниже указанный код в модуле формы.

 

 


Private blnRecordDelete     As Boolean  ' Флаг удаления
Private intRecordNumber     As Integer  ' Номер записи после которой произошло удаление

' Имя поля в котором храним номера строк
Private Const strcNameFieldNumber  As String = "Number"



'=============================================
'               ФОРМА
'=============================================
Private Sub Form_BeforeInsert(Cancel As Integer)
Dim rst As Object

    ' Присвоим порядковый номер новой записе
    Set rst = Me.RecordsetClone
    If rst.RecordCount > 0 Then rst.MoveLast
    Me.Controls(strcNameFieldNumber) = rst.RecordCount + 1
    Set rst = Nothing
End Sub


Private Sub Form_Current()
    If blnRecordDelete And intRecordNumber > 0 Then DeleteRecord
End Sub


Private Sub Form_Delete(Cancel As Integer)
Dim rst As Object

On Error Resume Next

    ' Что бы при множественном удалении не переписывать номера записей после каждой удаленной
    ' выставим флаги удаления, а перепись организуем в событии Текущая запись
    Set rst = Me.RecordsetClone
    rst.Bookmark = Me.Bookmark
    If Err.Number > 0 Then Set rst = NothingExit Sub
    intRecordNumber = rst.AbsolutePosition
    blnRecordDelete = True

    Set rst = Nothing
End Sub


'=============================================
'               КОНТРОЛ
'=============================================
Private Sub cmdUp_Click()
    MoveRecord True
End Sub



Private Sub cmdDown_Click()
    MoveRecord False
End Sub


'=============================================
'               ПРОЧЕЕ
'=============================================
Private Sub MoveRecord(blnUpward As Boolean)
Dim rst             As Object
Dim pos             As Integer
Dim bytRecType      As Byte     ' Тип рекордсета, он же и корректор для .AbsolutePosition

    ' Сохраним внесенные изменения
    Me.Dirty = False

    Set rst = Me.RecordsetClone
    bytRecType = GetTypeRecordset(rst)

    With rst
        .Bookmark = Me.Bookmark

        ' Проверим не является ли передвигаемая строка первой или последней, и если да, то ни чего не делаем
        If Not (Not blnUpward And (.AbsolutePosition = .RecordCount + (bytRecType - 1)) Or _
                   (blnUpward And (.AbsolutePosition = (0 + bytRecType)))) Then

            ' Откроем транзакцию (малоли что... а так сразу у обеих строк меняем номер, или не меняем)
            If Transaction("BeginTrans", bytRecType) Then
                On Error GoTo ErrorTrans

                ' Если передвигаем вверх, то перейдем на предыдущую строку
                If blnUpward Then .MovePrevious:    pos = .AbsolutePosition

                ' Начнем передвижение строк
                RecordEdit rst, bytRecType, .AbsolutePosition + (2 - bytRecType)
                .MoveNext
                RecordEdit rst, bytRecType, .AbsolutePosition - bytRecType

                ' Сохраним транзакцию
                Call Transaction("CommitTrans", bytRecType)
                On Error GoTo 0

                ' Обновляем форму и выставляемся на перемещаемую запись
                If Not blnUpward Then pos = .AbsolutePosition
                Me.Requery
                Me.Recordset.AbsolutePosition = pos
            End If
        End If
    End With

    Set rst = Nothing
    Exit Sub

ErrorTrans:
    Call Transaction("RollbackTrans", bytRecType)
    Set rst = Nothing
End Sub


Private Sub DeleteRecord()
Dim rst             As Object
Dim pos             As Integer
Dim bytRecType      As Byte

    Set rst = Me.RecordsetClone
    bytRecType = GetTypeRecordset(rst)
    pos = intRecordNumber

    ' Ну куда же мы без транзакции
    If Transaction("BeginTrans", bytRecType) Then
        On Error GoTo ErrorTrans

        With rst
            ' Пробежимся по записям после удаленых и перепишем номера
            .AbsolutePosition = intRecordNumber
            Do Until .EOF
                RecordEdit rst, bytRecType, .AbsolutePosition + 1
                .MoveNext
            Loop
        End With

        Call Transaction("CommitTrans", bytRecType)
        On Error GoTo 0

        blnRecordDelete = False:    intRecordNumber = 0
        Me.Requery
        If Me.NewRecord And rst.RecordCount > 0 Then Me.Recordset.MoveLast Else Me.Recordset.AbsolutePosition = pos

    End If
    Set rst = Nothing
    Exit Sub

ErrorTrans:
    Call Transaction("RollbackTrans", bytRecType)
    Set rst = Nothing
    blnRecordDelete = False:    intRecordNumber = 0
End Sub


' Вернет 1 - если рекордсет ADO, и 0 - если DAO
Private Function GetTypeRecordset(ByRef objRecordset As ObjectAs Byte
Dim bkm As Variant

    On Error Resume Next

    With objRecordset
        'Запомиаем закладку, что бы ее востановить по окончании
        bkm = .Bookmark
        .MoveFirst
        GetTypeRecordset = .AbsolutePosition
        'Востанавливае текущую запись, т.к. рекордсет передовали 'по ссылке'.
        .Bookmark = bkm
    End With
End Function


' Функция для работы с транзакцией
Private Function Transaction(strMethodTrans As String, bytTypeRecordset As ByteAs Byte
Dim trn         As Object

    On Error GoTo ErrorTrans

    If bytTypeRecordset = 0 Then
        Set trn = Application.DBEngine.Workspaces(0)
    Else
        Set trn = CurrentProject.Connection
    End If

    Select Case strMethodTrans
    Case "BeginTrans"
        trn.BeginTrans
    Case "CommitTrans"
        trn.CommitTrans
    Case Else
        If bytTypeRecordset = 0 Then trn.Rollback Else trn.RollbackTrans
    End Select

    Transaction = True

    Exit Function

ErrorTrans:
    Transaction = False
End Function


' Процедура изменения строки в рекордсете
Private Sub RecordEdit(ByRef objRecordset As Object, bytTypeRecordset As Byte, intNewNumber As Integer)
    ' Eсли рекордсет DAO то вызовим метод Edit
    If bytTypeRecordset = 0 Then objRecordset.Edit
    objRecordset.Fields(strcNameFieldNumber) = intNewNumber
    objRecordset.Update
End Sub

Код универсальный, будет работать как в mdb базах (DAO рекордсет), так и в adp проектах (ADO рекордсет)



Просмотров: 13732

  Коментарии (4)
 1 Написал(а) Сергей, в 10:26 04.02.2009
Очень сложная реализация.  
Я бы разнес реализацию для ADO и DAO по разным модулям. И использовал необходимый. 
Я бы реализовывал изменения порядка выполнением двух запросов с последующим обновлением данных на форме.  
А то, что в результате удаления возникают дырки, то это не так страшно, если номера не отображаются.
 2 Написал(а) АлексейЕ, в 07:01 11.02.2009
>Очень сложная реализация.  
 
Ну, профессия программиста вообще сложное дело.  
Если есть проще, то код в студию, на суд участников форума :) 
 
Я бы разнес реализацию для ADO и DAO по разным модулям. И использовал необходимый.  
 
Это кому как удобно, мне, что бы не парится, проще обыграть разные условия в одной реализации и забыть. 
 
>Я бы реализовывал изменения порядка выполнением двух запросов с последующим обновлением данных на форме.  
 
А кто-то вообще не заморачивался бы с нумерацией. 
Чем ваш вариант лучше, обоснуйте. Покажите вашу реализацию, может им буду пользоваться при условии сохранения всего того функционала который имеется в моем варианте. 
 
>А то, что в результате удаления возникают дырки, то это не так страшно, если номера не отображаются. 
 
Вот тут поподробнее пжлста… Отработка события Delete у меня происходит без запинки и задоринки как в mdb файле так и в adp проекте. Ни каких провалов. Возможно, не попадал в такую ситуацию, когда код глючит, и если это так, так давайте сделаем его лучше. 
 
:) :)
 3 Написал(а) alecks_lp, в 07:12 12.02.2009
Статья полезная как в реализации конкретной задачи, так и в демонстрации методов работы с объектами ADO & DAO - впрочем, полезность характерна для всех публикаций автора.  
Считаю необходимым ответить Сергею. 
1. Сложность реализации - это Ваша личная субъективная оценка. Кто-то оценит код с первого просмотра, а кто-то будет вникать, прогоняя в редакторе, а кто-то тупо вставит в проект и будет работать. А юзеру вообще наплевать на сложность реализации. 
2. - а вот Вы сделайте и опубликуйте и получите оценку.
 4 Написал(а) emf, в 06:25 28.02.2012
...во намудрил то )) 
 
-при удалении записи 
SELECT [Sort]+1 AS плюс1 
FROM Таблица1 
Where [Sort]+1 not in (SELECT Sort FROM Таблица1) 
смещаем те, что ниже, на позицию вверх(можно циклом, если записей несколько) 
 
-при добавлении возьмём максимум +1 
-пользователь вводит позицию, куда хочет переместить строку, например, с 200 на 100(до изменения) - сдвигаем номера ниже на +1 
 
а плюс в том, что не нужно кликать 100 раз кнопку :grin

Добавить коментарий
Имя:
E-mail
Коментарий:



Код:* Code

 
Реклама на сайте
HiProg.com - Технологии программирования
Rambler's Top100 TopList