Option Compare Database
Option Explicit

Const wdAlignParagraphLeft = 0
Const wdAlignParagraphCenter = 1
Const wdAlignParagraphRight = 2
Const wdTableFormatProfessional = 37
Const wdAutoFitContent = 1

Function CreateTableFromRecordset( _
 rngAny, _
 rstAny, _
 Optional fIncludeFieldNames As Boolean = False) _
 As Variant
 

    Dim objTable 'As Word.Table
    Dim fldAny 'As ADODB.Field
    Dim varData As Variant
    Dim strBookmark As String
    Dim cField As Long

    ' Get the data from the recordset
    varData = rstAny.GetString()
    
    ' Create the table
    With rngAny
    
        ' Creating the basic table is easy,
        ' just insert the tab-delimted text
        ' add convert it to a table
        .InsertAfter varData
        Set objTable = .ConvertToTable(vbTab)
        
        ' Field names are more work since
        ' you must do them one at a time
        If fIncludeFieldNames Then
            With objTable
            
                ' Add a new row on top and make it a heading
                .Rows.Add(.Rows(1)).HeadingFormat = True
                
                ' Iterate through the fields and add their
                ' names to the heading row
                For Each fldAny In rstAny.Fields
                    cField = cField + 1
                    .Cell(1, cField).Range.Text = fldAny.Name
                Next
            End With
        End If
    End With
    Set CreateTableFromRecordset = objTable
End Function

Public Function Contract()
Dim WD As Object
    Set WD = CreateObject("Word.Application")
    WD.Visible = True
    WD.Documents.Open FileName:=CurrentProject.Path & "\Контракт.dotx"
    WD.Application.WindowState = 1
    WD.Activate
    WD.ActiveDocument.Bookmarks("Number").Range.Text = Nz(Forms!Контракты!Номер_контракта, "")
    WD.ActiveDocument.Bookmarks("Data").Range.Text = Nz(Forms!Контракты!Дата_контракта, "")
    WD.ActiveDocument.Bookmarks("Summ").Range.Text = Nz(Format(Forms!Контракты!Сумма_контракта, " ######0.00р."))
    WD.ActiveDocument.Bookmarks("Name1").Range.Text = Nz(Forms!Контракты!подформаКлиенты.Form!ФИО, "")
    WD.ActiveDocument.Bookmarks("Name2").Range.Text = Nz(Forms!Контракты!подформаКлиенты.Form!ФИО, "")
    WD.ActiveDocument.Bookmarks("Phone").Range.Text = Nz(Forms!Контракты!подформаКлиенты.Form!Телефон, "")
    WD.ActiveDocument.Bookmarks("Addr1").Range.Text = Nz(Forms!Контракты!подформаКлиенты.Form!Адрес, "")
    WD.ActiveDocument.Bookmarks("Addr2").Range.Text = Nz(Forms!Контракты!подформаКлиенты.Form!Адрес, "")


     
    Dim rst
    Dim strSQL As String
    
    
    
    strSQL = "select " & vbCrLf & _
            " qMain.n as [Неделя]," & vbCrLf & _
            " sum(nPayL) as [Платеж]," & vbCrLf & _
            " qMain.nR as [Неделя_]," & vbCrLf & _
            " sum(Платеж) as [Платеж_]" & vbCrLf & _
            "from" & vbCrLf & _
            " (select n, n + qHalf.nHalf as nR, Платеж as nPayL" & vbCrLf & _
            "  from ((SELECT " & vbCrLf & _
            "   d1.id + d2.id*10 + d3.id*100 + 1 as n" & vbCrLf & _
            "  from " & vbCrLf & _
            "   digits d1, digits d2, digits d3" & vbCrLf & _
            "  )d inner join (select round(max(Номер_недели)/2+0.05,0) as nHalf from Платежи where Код_контракта = " & Forms!Контракты!Код_контракта & ") qHalf on d.n <= qHalf.nHalf)" & vbCrLf & _
            "  left join " & vbCrLf & _
            "    (select Номер_недели, Платеж from  Платежи where Код_контракта = " & Forms!Контракты!Код_контракта & ") as tPayL on tPayL.Номер_недели = d.n " & vbCrLf & _
            " ) qMain " & vbCrLf & _
            "left join " & vbCrLf & _
            "  (select Номер_недели, Платеж from  Платежи where Код_контракта = " & Forms!Контракты!Код_контракта & ") as tPayL on tPayL.Номер_недели = qMain.nR" & vbCrLf & _
            "group by n, nr;"
          
    Set rst = CurrentProject.Connection.Execute(strSQL)
    
    'Set rst = New Recordset
    'rst.Open strSQL, CurrentProject.Connection
    
    
    With CreateTableFromRecordset(WD.ActiveDocument.Bookmarks("Details").Range, rst, True)
        
        ' Apply formatting
        .AutoFormat wdTableFormatProfessional
        .AutoFitBehavior wdAutoFitContent
        
        ' Fix up paragraph alignment
        .Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        .Columns(1).Select
        WD.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        WD.Selection.MoveDown
    End With
    
    WD.ActiveDocument.SaveAs FileName:=CurrentProject.Path & "\" & "Контракт" & "_" & [Forms]![Контракты]![Номер_контракта] & ".docx"
End Function