VBA, MS Access MS Access в примерах

Обработка выделеных записей табличной формы

По материалам: https://www.cyberforum.ru/ms-access/thread1855441.html

В подчинённой форме:

Private blnSubFormMode As Boolean           ' If True =  форма открыта как подчинённая

Private Sub Form_Load()
    blnSubFormMode = FormHasParent(Me.Form) ' Форма открыта как подчинённая
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' Обработка выделеных записей - Selected Records Processing
'---------------------------------------------------------------------------------------
Dim iVal%, sTag$, lAbsolutePosEnd&
Const ciTotColumns% = 3 ' Кол-во столбцов в табличной форме для сравнения
    
    ' SelWidth  : Количество выбранных столбцов (полей) в текущем прямоугольнике выделения.
    ' SelHeight : Количество выбранных строк (записей)
    ' Debug.Print "SW: " & Me.SelWidth & "- SH: " & SelHeight

' Проверка на кол-во выделенных строк:
    If Me.SelHeight = 0 Then GoTo Form_MouseUp_End

' Экран на выделенную новую запись:
    If Me.SelHeight = 1 And Me.NewRecord = True Then GoTo Form_MouseUp_End
    
' Проверка на кол-во выделенных столбцов (если все = допустимо):
    iVal = Me.SelWidth
    If iVal < ciTotColumns And iVal > 0 Then GoTo Form_MouseUp_End

    With Me.RecordsetClone
        .AbsolutePosition = Me.SelTop - 1
        lAbsolutePosEnd = .AbsolutePosition + Me.SelHeight - 1
        For iVal = .AbsolutePosition To lAbsolutePosEnd
            If .EOF = False Then
                sTag = sTag & "," & !RecordID
                .MoveNext
            End If
        Next
    End With

Form_MouseUp_End:
    If Len(sTag) > 1 Then sTag = Mid(sTag, 2) ' Заполнение свойства Tag формы
    Me.Tag = sTag
    
' Обновление информационного поля в гланой форме - С данными : =[objSubForm].[Form].[Tag]
    If blnSubFormMode Then Me.Parent.TextBoxSubfFrmTag.Requery
End Sub

Private Function FormHasParent(objForm As Form) As Boolean
' Проверка что форма ,на данный момент, отображается как подчинённая
' Checking that the form, at the moment, is displayed as subform
'--------------------------------------------------------------------
On Error GoTo FormHasParent_Err
    FormHasParent = TypeName(objForm.Parent.Name) = "String"
    Exit Function
FormHasParent_Err:
    Err.Clear
End Function



На кнопке в главной форме:

Private Sub CommandSelectedRecords_Click()
Dim sVal$
    
    sVal = objSubForm.Form.Tag

'Зачистка т.к. подчинённая уже потеряла фокус и выделение "слетело" уже
    Me.objSubForm.Form.Tag = ""
    Me.TextBoxSubfFrmTag.Requery
    
    If Len(sVal) = 0 Then
        MsgBox "Нет выделенных записей!", vbExclamation
        Exit Sub
    Else
        'Запрос поддтверждения при ответе НЕТ - остановка
        If MsgBox("Действительно удалить записи с кодами:" & vbCrLf & _
        sVal & vbCrLf & "При ответе [Да] - записи будут удалены.", _
            vbYesNo + vbQuestion + vbDefaultButton2, _
            "Удаление записей") = vbNo Then Exit Sub
    End If

' Удаление:
    sVal = "DELETE FROM tabl WHERE RecordID IN (" & sVal & ")"
    CurrentDb.Execute sVal
    Me.objSubForm.Form.Requery
End Sub

Picture




Скачать

MSA-2007 и выше ( 56 kB) Пример


Назад ToTop
L.E. 13.02.2024
Рейтинг@Mail.ru