Не работает цикл для вывода записей из Access в Excel - VBA

Узнай цену своей работы

Формулировка задачи:

Здравствуйте! Создаю отчет в Excel на основе данных из Access. Имеется форма, надо на её основе построить отчет в Excel. Проблема с выводом подчиненной формы (снизу формы). Сделал такой цикл, но он выводит только первую строку таблицы зданий (строка 301):
Листинг программы 
  1. Public Sub AccountExcel()
  2.  
  3. Dim RSset As ADODB.Recordset  ' Набор данных
  4. Set RSset = New ADODB.Recordset
  5. ' Рабочие переменные. Их тип - Variant
  6. Dim I, RightAddress
  7. Dim SQLText, SQLText1 As String
  8. Dim oExcel As Object
  9. ' Создание объекта
  10. Set oExcel = CreateObject("Excel.Application")
  11. ' Локальные переменные
  12. Dim ClientAddress, ObjectAddress, nRow, ClientFIO
  13.  
  14. ' Сделать окно Microsoft Excel видимым
  15.     oExcel.Application.Visible = True
  16.     oExcel.Application.CommandBars("Standard").Visible = False
  17.     oExcel.Application.CommandBars("Formatting").Visible = False
  18. ' Размеры окна и его место на экране дисплея
  19.     oExcel.Application.WindowState = xlMaximized
  20. ' Добавляем рабочую книгу
  21.     oExcel.WorkBooks.Add
  22. ' При закрытии рабочей книги без сохранения
  23. ' ошибка формироваться не будет
  24.     oExcel.DisplayAlerts = False
  25. ' Масштаб изображения 75%
  26.     oExcel.ActiveWindow.Zoom = 75
  27. ' Заголовок окна Excel
  28.     oExcel.Caption = "Договор"
  29. ' Ориентация альбомная поля по 1.5 см Бумага A4
  30.     oExcel.ActiveSheet.PageSetup.LeftMargin = 42
  31.     oExcel.ActiveSheet.PageSetup.RightMargin = 42
  32.     oExcel.ActiveSheet.PageSetup.TopMargin = 42
  33.     oExcel.ActiveSheet.PageSetup.BottomMargin = 42
  34.     oExcel.ActiveSheet.PageSetup.Orientation = xlLandscape
  35.     oExcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
  36. ' Для всей Excel-таблицы
  37.     oExcel.Cells.Font.Name = "Arial"
  38.     oExcel.Cells.Font.Size = 8
  39.  
  40. ' Устанавливаем ширину колонок
  41.     oExcel.Columns("A:A").ColumnWidth = 16
  42.     oExcel.Columns("B:B").ColumnWidth = 11
  43.     oExcel.Columns("C:C").ColumnWidth = 7
  44.     oExcel.Columns("D:D").ColumnWidth = 7
  45.     oExcel.Columns("E:E").ColumnWidth = 14
  46.     oExcel.Columns("F:F").ColumnWidth = 11
  47.  
  48.     oExcel.Range("B1:D1").Select
  49.     With oExcel.Selection
  50.         .HorizontalAlignment = xlRight
  51.         .VerticalAlignment = xlBottom
  52.         .WrapText = False
  53.         .Orientation = 0
  54.         .AddIndent = False
  55.         .IndentLevel = 0
  56.         .ShrinkToFit = False
  57.         .ReadingOrder = xlContext
  58.         .MergeCells = False
  59.     End With
  60.     oExcel.Selection.Merge
  61.     oExcel.Range("B1:D1").Select
  62.     oExcel.ActiveCell.FormulaR1C1 = "Договор охраны объекта №"
  63.     oExcel.Range("E1").Select
  64.     With oExcel.Selection
  65.         .HorizontalAlignment = xlLeft
  66.         .VerticalAlignment = xlBottom
  67.         .WrapText = False
  68.         .Orientation = 0
  69.         .AddIndent = False
  70.         .IndentLevel = 0
  71.         .ShrinkToFit = False
  72.         .ReadingOrder = xlContext
  73.         .MergeCells = False
  74.     End With
  75.     oExcel.ActiveCell.FormulaR1C1 = SelectTreatyID
  76.  
  77.     oExcel.Range("A3").Select
  78.     oExcel.ActiveCell.FormulaR1C1 = "ФИО клиента:"
  79.  
  80. ClientFIO = SelectClientSurname & " " & _
  81.         SelectClientName & " " & _
  82.         SelectClientPatronymic
  83.         
  84.     oExcel.Range("B3:E3").Select
  85.     With oExcel.Selection
  86.         .HorizontalAlignment = xlLeft
  87.         .VerticalAlignment = xlBottom
  88.         .WrapText = False
  89.         .Orientation = 0
  90.         .AddIndent = False
  91.         .IndentLevel = 0
  92.         .ShrinkToFit = False
  93.         .ReadingOrder = xlContext
  94.         .MergeCells = False
  95.     End With
  96.     oExcel.Selection.Merge
  97.     oExcel.ActiveCell.FormulaR1C1 = ClientFIO
  98.     
  99.     oExcel.Range("A4").Select
  100.     With oExcel.Selection
  101.         .HorizontalAlignment = xlLeft
  102.         .VerticalAlignment = xlBottom
  103.         .WrapText = False
  104.         .Orientation = 0
  105.         .AddIndent = False
  106.         .IndentLevel = 0
  107.         .ShrinkToFit = False
  108.         .ReadingOrder = xlContext
  109.         .MergeCells = False
  110.     End With
  111.     oExcel.ActiveCell.FormulaR1C1 = "Телефон:"
  112.     
  113.     oExcel.Range("B4:E4").Select
  114.     With oExcel.Selection
  115.         .HorizontalAlignment = xlLeft
  116.         .VerticalAlignment = xlBottom
  117.         .WrapText = False
  118.         .Orientation = 0
  119.         .AddIndent = False
  120.         .IndentLevel = 0
  121.         .ShrinkToFit = False
  122.         .ReadingOrder = xlContext
  123.         .MergeCells = False
  124.     End With
  125.     oExcel.Selection.Merge
  126.     oExcel.ActiveCell.FormulaR1C1 = SelectClientPhone
  127.  
  128.     With RSset
  129.      ' Задание свойств объекта RSset (Recordset)
  130.      ' Источник: SQL-конструкция
  131.      
  132.      SQLText = "SELECT * FROM tblAddress " & _
  133.                 " WHERE Address = " & SelectClientAddress
  134.  
  135.      .Source = SQLText
  136.      
  137.      ' Указатель на открытое соединение
  138.      .ActiveConnection = CurrentProject.Connection
  139.      .CursorType = adOpenKeyset   ' Тип курсора
  140.      .Open
  141.     End With
  142.      
  143.      If RSset(3) = False Then
  144.    ' Признак адреса стоит первым
  145.    RightAddress = Trim(RSset(2)) & " " & _
  146.                 Trim(RSset(1))
  147.     Else
  148.     ' Признак адреса стоит вторым
  149.    RightAddress = Trim(RSset(1)) & " " & _
  150.                 Trim(RSset(2))
  151.     End If
  152. RSset.Close ' Закрытие набора данных
  153.     
  154.     oExcel.Range("A5").Select
  155.     oExcel.ActiveCell.FormulaR1C1 = "Адрес клиента:"
  156.     
  157.     ClientAddress = "г. Хабаровск, " & _
  158.     RightAddress & ", дом " & _
  159.     str(SelectClientHouse) & ", кв. " & _
  160.     str(SelectClientFlat) & "."
  161.     
  162.     oExcel.Range("A3:A5").Select
  163.     oExcel.Selection.Font.Bold = True
  164.     With oExcel.Selection
  165.         .HorizontalAlignment = xlLeft
  166.         .VerticalAlignment = xlBottom
  167.         .WrapText = False
  168.         .Orientation = 0
  169.         .AddIndent = False
  170.         .IndentLevel = 0
  171.         .ShrinkToFit = False
  172.         .ReadingOrder = xlContext
  173.         .MergeCells = False
  174.     End With
  175.     
  176.     oExcel.Range("B5:E5").Select
  177.     With oExcel.Selection
  178.         .HorizontalAlignment = xlLeft
  179.         .VerticalAlignment = xlBottom
  180.         .WrapText = False
  181.         .Orientation = 0
  182.         .AddIndent = False
  183.         .IndentLevel = 0
  184.         .ShrinkToFit = False
  185.         .ReadingOrder = xlContext
  186.         .MergeCells = False
  187.     End With
  188.     oExcel.Selection.Merge
  189.     oExcel.ActiveCell.FormulaR1C1 = ClientAddress
  190.  
  191.     oExcel.Range("A7").Select
  192.     oExcel.Selection.Font.Bold = True
  193.     oExcel.ActiveCell.FormulaR1C1 = "Дата начала договора:"
  194.     oExcel.Range("B7").Select
  195.     oExcel.ActiveCell.FormulaR1C1 = SelectDateStart
  196.     
  197.     oExcel.Range("C7:E7").Select
  198.     With oExcel.Selection
  199.         .HorizontalAlignment = xlLeft
  200.         .VerticalAlignment = xlBottom
  201.         .WrapText = False
  202.         .Orientation = 0
  203.         .AddIndent = False
  204.         .IndentLevel = 0
  205.         .ShrinkToFit = False
  206.         .ReadingOrder = xlContext
  207.         .MergeCells = False
  208.     End With
  209.  
  210.     oExcel.ActiveCell.FormulaR1C1 = "Дата окончания договора:"
  211.     oExcel.Range("C7:E7").Select
  212.     oExcel.Selection.Font.Bold = True
  213.     
  214.     oExcel.Range("F7").Select
  215.     oExcel.ActiveCell.FormulaR1C1 = SelectStopDate
  216.     
  217.     oExcel.Range("B9:F9").Select
  218.     With oExcel.Selection
  219.         .HorizontalAlignment = xlCenter
  220.         .VerticalAlignment = xlBottom
  221.         .WrapText = False
  222.         .Orientation = 0
  223.         .AddIndent = False
  224.         .IndentLevel = 0
  225.         .ShrinkToFit = False
  226.         .ReadingOrder = xlContext
  227.         .MergeCells = False
  228.     End With
  229.     oExcel.Selection.Merge
  230.     oExcel.ActiveCell.FormulaR1C1 = "Объекты охраны, прописанные в договоре:"
  231.     
  232.     oExcel.Range("A10").Select
  233.     With oExcel.Selection
  234.         .HorizontalAlignment = xlCenter
  235.         .VerticalAlignment = xlBottom
  236.         .WrapText = False
  237.         .Orientation = 0
  238.         .AddIndent = False
  239.         .IndentLevel = 0
  240.         .ShrinkToFit = False
  241.         .ReadingOrder = xlContext
  242.         .MergeCells = False
  243.     End With
  244.     oExcel.ActiveCell.FormulaR1C1 = "Объект №"
  245.     oExcel.Range("B10:E10").Select
  246.     With oExcel.Selection
  247.         .HorizontalAlignment = xlLeft
  248.         .VerticalAlignment = xlBottom
  249.         .WrapText = False
  250.         .Orientation = 0
  251.         .AddIndent = False
  252.         .IndentLevel = 0
  253.         .ShrinkToFit = False
  254.         .ReadingOrder = xlContext
  255.         .MergeCells = False
  256.     End With
  257.     oExcel.Selection.Merge
  258.     oExcel.ActiveCell.FormulaR1C1 = "Адрес:"
  259.     oExcel.Range("F10").Select
  260.     oExcel.ActiveCell.FormulaR1C1 = "Дом"
  261.     oExcel.Range("G10").Select
  262.     oExcel.ActiveCell.FormulaR1C1 = "Кв."
  263.     oExcel.Range("A10:G10").Select
  264.     oExcel.Selection.Font.Bold = True
  265.  
  266. With RSset
  267.      ' Задание свойств объекта RSset (Recordset)
  268.      ' Источник: SQL-конструкция
  269.      
  270.     SQLText = "SELECT tblTreatyDetail.TreatyID, tblTreatyDetail.ObjectID, " & _
  271.     " tblAddress.AddressName, tblAddress.AddressSign, tblAddress.AddressFirst, " & _
  272.     " tblObject.House, tblObject.Flat " & _
  273.     " FROM tblTreaty INNER JOIN ((tblAddress INNER JOIN tblObject " & _
  274.     " ON tblAddress.Address = tblObject.Address) INNER JOIN tblTreatyDetail " & _
  275.     " ON tblObject.ObjectID = tblTreatyDetail.ObjectID)" & _
  276.     " ON tblTreaty.TreatyID = tblTreatyDetail.TreatyID " & _
  277.     " WHERE tblTreatyDetail.TreatyID = " & SelectTreatyID & _
  278.     " AND tblTreatyDetail.ObjectID = " & SelectObjectID
  279.     
  280.     .Source = SQLText
  281.      
  282.      ' Указатель на открытое соединение
  283.      .ActiveConnection = CurrentProject.Connection
  284.      .CursorType = adOpenKeyset   ' Тип курсора
  285.      .Open
  286.     End With
  287.      
  288.      If RSset(4) = False Then
  289.    ' Признак адреса стоит первым
  290.    RightAddress = Trim(RSset(3)) & " " & _
  291.                 Trim(RSset(2))
  292.     Else
  293.     ' Признак адреса стоит вторым
  294.    RightAddress = Trim(RSset(2)) & " " & _
  295.                 Trim(RSset(3))
  296.     End If
  297.  
  298. For I = 0 To RSset.RecordCount - 1
  299.     RSset.Move I, adBookmarkFirst
  300.     oExcel.Range("B" & I + 11 & ":E" & I + 11).Select
  301.     With oExcel.Selection
  302.         .HorizontalAlignment = xlLeft
  303.         .VerticalAlignment = xlBottom
  304.         .WrapText = False
  305.         .Orientation = 0
  306.         .AddIndent = False
  307.         .IndentLevel = 0
  308.         .ShrinkToFit = False
  309.         .ReadingOrder = xlContext
  310.         .MergeCells = False
  311.     End With
  312.     oExcel.Selection.Merge
  313.     With oExcel
  314.     .Range("A" & I + 11).Select
  315.     .ActiveCell.FormulaR1C1 = RSset.Fields(1).Value
  316.     .Range("B" & I + 11 & ":E" & I + 11).Select
  317.     .ActiveCell.FormulaR1C1 = RightAddress
  318.     .Range("F" & I + 11).Select
  319.     .ActiveCell.FormulaR1C1 = RSset.Fields(5).Value
  320.     .Range("G" & I + 11).Select
  321.     .ActiveCell.FormulaR1C1 = RSset.Fields(6).Value
  322.     End With
  323. Next I
  324.  
  325. ' Переход в начало отчета
  326. oExcel.Range("A1").Select
  327. ' Устанавливаем защиту рабочего листа и книги
  328. ' Пароль - текущее время
  329. oExcel.ActiveSheet.Protect ("' + Time() + '")
  330. oExcel.ActiveWorkbook.Protect ("' + Time() + '")
  331. RSset.Close
  332. Set RSset = Nothing
  333. End Sub
В чем может быть ошибка? И, есть советы как сделать форматирование этой таблицы (границы)? БД Access 2010:47 Маслов 5.rar

Решение задачи: «Не работает цикл для вывода записей из Access в Excel»

textual
Листинг программы 
  1. RSset.novelast
  2. RSset.movefirst
  3. For I = 0 To RSset.RecordCount - 1
  4. ''''' действия
  5. RSset.movenext
  6. next i

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

10   голосов , оценка 4.3 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут