Option Compare Database
Option Explicit
Private Sub Кнопка33_Click()
    Me.Список58.RowSource = Me.Список58.RowSource & ";" & Me.Поля & ";" & Me.ПолеСоСписком2
    Me.Список21.RowSource = Me.Список21.RowSource & ";" & Me.Поля & ";" & Me.ПолеСоСписком2 
    Me.Поле45 = Me.Поле45 & Me.ПолеСоСписком38 & ";"
    Me.Поле47 = Me.Поле47 & Me.Поля & ";"
    Me.Поле62 = Me.Поле62 & Me.ПолеСоСписком2 & ";"
    If Me.ПолеСоСписком38 <> "Адреса" Then Me.Поле64 = Me.Поле64 & Me.ПолеСоСписком38 & ";"
    Me.Список58.Requery
    Me.Список21.Requery
    Me.Поле45.Requery
    Me.Поле47.Requery
    Me.Поле62.Requery
    Me.Поле64.Requery 
End Sub

Private Sub Кнопка34_Click()
    Me.Список58.RowSource = "Поле;Запись"
    Me.Список21.RowSource = "Поле;Значение"
    Me.Поле45 = ""
    Me.Поле47 = ""
    Me.Поле62 = ""
    Me.Поле64 = ""
End Sub

Private Sub Кнопка5_Click()
If Me.Список58.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, otch
Dim tmp, s, p, u
Dim X As Integer
Dim Y, w, ch
    s = Split(Me.Поле45, ";")
    otch = "Запрос - " & s(0)
    Me.Поле69 = s(0)
    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!Список21.RowSource) > 0 Then
    fv = Split(Me!Список21.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(otch).SQL = sq
    Set fl = Nothing: Set db = Nothing
    DoCmd.OpenQuery otch, 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(otch).SQL = sq
    DoCmd.OpenQuery otch
  End If
    Me.Список58.RowSource = "Поле;Запись"
    Me.Список21.RowSource = "Поле;Значение"
    Me.Поле45 = ""
    Me.Поле47 = ""
    Me.Поле62 = ""
    Me.Поле64 = ""
End Sub

Private Sub ПолеСоСписком38_AfterUpdate()
    Me.Поля.RowSource = Me.ПолеСоСписком38
End Sub

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

Private Sub Кнопка35_Click()
On Error GoTo Err_Кнопка35_Click
    Dim stDocName As String
    stDocName = ChrW(1047) & ChrW(1072) & ChrW(1087) & ChrW(1088) & ChrW(1086) & ChrW(1089) & ChrW(32) & ChrW(1089) & ChrW(1090) & ChrW(1091) & ChrW(1076) & ChrW(1077) & ChrW(1085) & ChrW(1090)
    DoCmd.OpenReport stDocName, acPreview
Exit_Кнопка35_Click:
    Exit Sub
Err_Кнопка35_Click:
    MsgBox Err.Description
    Resume Exit_Кнопка35_Click
End Sub

Private Sub Кнопка68_Click()
    DoCmd.OpenReport Me.Поле69, acViewReport
End Sub