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

Строка по данным записей подчинённой формы

Статья написана по мотивам вопросов на одном из форумов.
Бывает (ну бывает), нужно получить совокупную строку из данных подчинённой формы (одной стркой)

Для выввода значения в поле главной формы:
В главной форме, в нужное поле, ставим свойство Источник Данных = StringValuesFromSubform([Подчинённая_Форма];"Название_Поля_Откуда")
Где : "[Подчинённая_Форма]" ссылка на обьект "подчинённая форма", "Название_Поля_Откуда" - понятно, а делитель пропущен (будет = ; ).

Private Function StringValuesFromSubform(ObjectSubForm As SubForm, strFieldName$, Optional sDelimiter$ = "; ") As String
'Возвращает строку по данным подчинённой формы (сборка значений поля по всем записям)
'--------------------------------------------------------------------------
'Аргументы:
'   ObjectSubForm  = Ссылка обьект подчинённая форма
'   strFieldName   = Название поля в источнике данных формы - Откуда?!
'   sDelimiter     = Опционально: Разделитель значений (по умолчанию = "; ")
'--------------------------------------------------------------------------
Dim rst As DAO.Recordset
Dim sTempString As String
On Error GoTo StringValuesFromSubform_Err
    
    Set rst = ObjectSubForm.Form.RecordsetClone
    
    With rst
        Do Until .EOF = True
            sTempString = sTempString & sDelimiter & .Fields(strFieldName)
            .MoveNext
        Loop
    End With
    
    If Len(sTempString) > 0 Then StringValuesFromSubform = Mid(sTempString, Len(sDelimiter) + 1)
    'Debug.Print StringValuesFromSubform

StringValuesFromSubform_End:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Exit Function
    
StringValuesFromSubform_Err:
    'StringValuesFromSubform = "ERR: " & Err.Number
    MsgBox "Процедура StringValuesFromSubform привела к ошибке:" & vbCrLf & _
        Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical
    Resume StringValuesFromSubform_End
End Function


На снимке, источник данных поля:
=StringValuesFromSubform([objSubForm];"GoodName";Chr(13) & Chr(10))
... последний аргумент = ПереводСтроки (вместо точки с запяотой по умолчанию)

Picture

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