Option Compare Database
Option Explicit
Private Sub Выполнить_запрос_Click()
If Me.ПараметрыЗапроса.RowSource = "Таблица;Поле;Значение" Then Exit Sub
Dim sq$, fv, sv$, i&, db As DAO.Database, fl As DAO.Field
Dim Res()
Dim Pes()
Dim n, j, k, l
Dim tmp, s, p, u
Dim X As Integer
Dim Y, w, ch
    s = Split(Me.Поле45, ";")
    n = UBound(s, 1)
    ReDim Res(0 To n + 1)
    Res(0) = s(0)
    j = 1
    For i = 1 To n
        tmp = s(i)
        k = 0
        For l = 0 To j
            If tmp = Res(l) Then
               k = -1
               Exit For
            End If
        Next l
        If k = 0 Then
           j = j + 1
           Res(j) = tmp
        End If
     Next i
     ReDim Preserve Res(0 To j)
  If UBound(Res, 1) = 1 Then
    sq = "SELECT * FROM [" & Res(0) & "] WHERE True"
        Set db = CurrentDb
    If Len(Me.ПараметрыЗапроса1.RowSource) > 0 Then
    fv = Split(Me ПараметрыЗапроса1.RowSource, ";")
        For Each fl In db.TableDefs(Me.Поля.RowSource).Fields
        sv = ""
        For i = 0 To UBound(fv) Step 2
            If fl.Name = fv(i) Then
            Select Case fl.Type
                Case dbBigInt, dbBoolean, dbByte, dbCurrency, dbDecimal, _
                 dbDouble, dbFloat, dbInteger, dbLong, dbNumeric, dbSingle
                sv = sv & "," & Replace(fv(i + 1), ",", ".")
                Case dbChar, dbText
                sv = sv & ",'" & fv(i + 1) & "'"
                Case dbDate
                sv = sv & ",#" & Format(CDate(fv(i + 1)), "mm\/dd\/yyyy") & "#"
            End Select
            End If
        Next
        If Len(sv) > 0 Then sq = sq & " And [" & fl.Name & "] In (" & Mid(sv, 2) & ")"
        Next
    End If
    db.QueryDefs("Запрос").SQL = sq
    Set fl = Nothing: Set db = Nothing
    DoCmd.OpenQuery "Запрос", acViewNormal
  Else
    p = Split(Me.Поле64, ";")
    n = UBound(p, 1)
    ReDim Pes(0 To n + 1)
    Pes(0) = p(0)
    j = 1
    For i = 1 To n
        tmp = p(i)
        k = 0
        For l = 0 To j
            If tmp = Pes(l) Then
               k = -1
               Exit For
            End If
        Next l
        If k = 0 Then
           j = j + 1
           Pes(j) = tmp
        End If
    Next i
    ReDim Preserve Pes(0 To j)
        If UBound(Pes, 1) > 2 Then
            For i = 2 To UBound(Pes, 1)
            u = u & "("
            Next i
        End If
            
    sq = "SELECT * FROM " & u & "Адреса INNER JOIN [" & Pes(0) & "] ON Адре-са.[Наименование населенного пункта]=[" & Pes(0) & "].[Наименование населенного пункта]"
    If UBound(Pes, 1) > 1 Then
        For i = 2 To UBound(Pes, 1)
            sq = sq & ") INNER JOIN [" & Pes(i) & "] ON Адреса.[Наименование насе-ленного пункта]=[" & Pes(i) & "].[Наименование населенного пункта]"
        Next i
    End If
    sq = sq & " WHERE True and "
    Y = Split(Me.Поле47, ";")
    w = Split(Me.Поле62, ";")
    For i = 0 To UBound(w)
        If IsNumeric(w(i)) Or IsDate(w(i)) Then
            k = 1
        Else
            w(i) = "'" & w(i) & "'"
        End If
        If IsNumeric(w(i)) Then
            w(i) = w(i)
        End If
        If IsDate(w(i)) Then
            w(i) = "#" & Format(CDate(w(i)), "mm\/dd\/yyyy") & "#"
        End If
    Next i
    ch = Y(0)
    sv = "[" & s(0) & "].[" & ch & "] in (" & w(0)
    For i = 1 To UBound(Y, 1) - 1
        If ch = Y(i) Then
            sv = sv & "," & w(i)
        Else
            sv = sv & ") and [" & s(i) & "].[" & Y(i) & "] in (" & w(i)
            ch = Y(i)
        End If
    Next i
    sv = sv & ")"
    sq = sq & sv
    sq = sq & ";"
    CurrentDb.QueryDefs("Запрос").SQL = sq
    DoCmd.OpenQuery "Запрос"
  End If
    Me.ПараметрыЗапроса.RowSource = "Таблица;Поле;Значение"
    Me.ПараметрыЗапроса1.RowSource = "Поле;Значение"
    Me.Поле45 = ""
    Me.Поле47 = ""
    Me.Поле62 = ""
    Me.Поле64 = ""
End Sub

Private Sub Добавить_Click()
    Me.ПараметрыЗапроса.RowSource = Me.ПараметрыЗапроса.RowSource & ";" & Me.СписокТаблиц & ";" & Me.Поля & ";" & Me.СписокЗаписей
    Me.ПараметрыЗапроса1.RowSource = Me.ПараметрыЗапроса1.RowSource & ";" & Me.Поля & ";" & Me.СписокЗаписей
    Me.Поле45 = Me.Поле45 & Me.СписокТаблиц & ";"
    Me.Поле47 = Me.Поле47 & Me.Поля & ";"
    Me.Поле62 = Me.Поле62 & Me.СписокЗаписей & ";"
    If Me.СписокТаблиц <> "Адреса" Then Me.Поле64 = Me.Поле64 & Me.СписокТаблиц & ";"
    Me.ПараметрыЗапроса.Requery
    Me.ПараметрыЗапроса1.Requery
    Me.Поле45.Requery
    Me.Поле47.Requery
    Me.Поле62.Requery
    Me.Поле64.Requery
End Sub

Private Sub Отмена_Click()
    Me.ПараметрыЗапроса.RowSource = "Таблица;Поле;Значение"
    Me.ПараметрыЗапроса1.RowSource = "Поле;Значение"
    Me.Поле45 = ""
    Me.Поле47 = ""
    Me.Поле62 = ""
    Me.Поле64 = ""
End Sub

Private Sub Поля_AfterUpdate()
    If Not IsNull(Me.Поля) Then
        Me.СписокЗаписей = Null
        Me.СписокЗаписей.RowSource = "SELECT DISTINCT [" & Me.Поля & "] FROM [" & Me.СписокТаблиц & "] ORDER BY [" & Me.Поля & "]"
'        Me.СписокЗаписей.Requery
        Me.СписокЗаписей.SetFocus
        Me.СписокЗаписей.Dropdown
    End If
End Sub
Private Sub СписокТаблиц_AfterUpdate()
    Me.Поля.RowSource = Me.СписокТаблиц
End Sub