Форум программистов, компьютерный форум, киберфорум
VBA
Форум программистов и сисадминов Киберфорум > Форум программистов > Basic > VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.63/8: Рейтинг темы: голосов - 8, средняя оценка - 4.63
4 / 4 / 0
Регистрация: 01.03.2016
Сообщений: 139

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

13.05.2017, 06:15. Показов 1634. Ответов 6
Метки нет (Все метки)
Студворк — интернет-сервис помощи студентам
Здравствуйте! Создаю отчет в Excel на основе данных из Access.
Имеется форма, надо на её основе построить отчет в Excel.


Проблема с выводом подчиненной формы (снизу формы).
Сделал такой цикл, но он выводит только первую строку таблицы зданий (строка 301):
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337

Public Sub AccountExcel()
 
Dim RSset As ADODB.Recordset  ' Набор данных
Set RSset = New ADODB.Recordset
' Рабочие переменные. Их тип - Variant
Dim I, RightAddress
Dim SQLText, SQLText1 As String
Dim oExcel As Object
' Создание объекта
Set oExcel = CreateObject("Excel.Application")
' Локальные переменные
Dim ClientAddress, ObjectAddress, nRow, ClientFIO
 
' Сделать окно Microsoft Excel видимым
    oExcel.Application.Visible = True
    oExcel.Application.CommandBars("Standard").Visible = False
    oExcel.Application.CommandBars("Formatting").Visible = False
' Размеры окна и его место на экране дисплея
    oExcel.Application.WindowState = xlMaximized
' Добавляем рабочую книгу
    oExcel.WorkBooks.Add
' При закрытии рабочей книги без сохранения
' ошибка формироваться не будет
    oExcel.DisplayAlerts = False
' Масштаб изображения 75%
    oExcel.ActiveWindow.Zoom = 75
' Заголовок окна Excel
    oExcel.Caption = "Договор"
' Ориентация альбомная поля по 1.5 см Бумага A4
    oExcel.ActiveSheet.PageSetup.LeftMargin = 42
    oExcel.ActiveSheet.PageSetup.RightMargin = 42
    oExcel.ActiveSheet.PageSetup.TopMargin = 42
    oExcel.ActiveSheet.PageSetup.BottomMargin = 42
    oExcel.ActiveSheet.PageSetup.Orientation = xlLandscape
    oExcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
' Для всей Excel-таблицы
    oExcel.Cells.Font.Name = "Arial"
    oExcel.Cells.Font.Size = 8
 
' Устанавливаем ширину колонок
    oExcel.Columns("A:A").ColumnWidth = 16
    oExcel.Columns("B:B").ColumnWidth = 11
    oExcel.Columns("C:C").ColumnWidth = 7
    oExcel.Columns("D:D").ColumnWidth = 7
    oExcel.Columns("E:E").ColumnWidth = 14
    oExcel.Columns("F:F").ColumnWidth = 11
 
    oExcel.Range("B1:D1").Select
    With oExcel.Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.Range("B1:D1").Select
    oExcel.ActiveCell.FormulaR1C1 = "Договор охраны объекта №"
    oExcel.Range("E1").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.ActiveCell.FormulaR1C1 = SelectTreatyID
 
    oExcel.Range("A3").Select
    oExcel.ActiveCell.FormulaR1C1 = "ФИО клиента:"
 
ClientFIO = SelectClientSurname & " " & _
        SelectClientName & " " & _
        SelectClientPatronymic
        
    oExcel.Range("B3:E3").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = ClientFIO
    
    oExcel.Range("A4").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.ActiveCell.FormulaR1C1 = "Телефон:"
    
    oExcel.Range("B4:E4").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = SelectClientPhone
    
    
    With RSset
     ' Задание свойств объекта RSset (Recordset)
     ' Источник: SQL-конструкция
     
     SQLText = "SELECT * FROM tblAddress " & _
                " WHERE Address = " & SelectClientAddress
 
     .Source = SQLText
     
     ' Указатель на открытое соединение
     .ActiveConnection = CurrentProject.Connection
     .CursorType = adOpenKeyset   ' Тип курсора
     .Open
    End With
     
     If RSset(3) = False Then
   ' Признак адреса стоит первым
   RightAddress = Trim(RSset(2)) & " " & _
                Trim(RSset(1))
    Else
    ' Признак адреса стоит вторым
   RightAddress = Trim(RSset(1)) & " " & _
                Trim(RSset(2))
    End If
RSset.Close ' Закрытие набора данных
    
    oExcel.Range("A5").Select
    oExcel.ActiveCell.FormulaR1C1 = "Адрес клиента:"
    
    ClientAddress = "г. Хабаровск, " & _
    RightAddress & ", дом " & _
    str(SelectClientHouse) & ", кв. " & _
    str(SelectClientFlat) & "."
    
    oExcel.Range("A3:A5").Select
    oExcel.Selection.Font.Bold = True
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    oExcel.Range("B5:E5").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = ClientAddress
 
    oExcel.Range("A7").Select
    oExcel.Selection.Font.Bold = True
    oExcel.ActiveCell.FormulaR1C1 = "Дата начала договора:"
    oExcel.Range("B7").Select
    oExcel.ActiveCell.FormulaR1C1 = SelectDateStart
    
    oExcel.Range("C7:E7").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
    oExcel.ActiveCell.FormulaR1C1 = "Дата окончания договора:"
    oExcel.Range("C7:E7").Select
    oExcel.Selection.Font.Bold = True
    
    oExcel.Range("F7").Select
    oExcel.ActiveCell.FormulaR1C1 = SelectStopDate
    
    oExcel.Range("B9:F9").Select
    With oExcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = "Объекты охраны, прописанные в договоре:"
    
    oExcel.Range("A10").Select
    With oExcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.ActiveCell.FormulaR1C1 = "Объект №"
    oExcel.Range("B10:E10").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = "Адрес:"
    oExcel.Range("F10").Select
    oExcel.ActiveCell.FormulaR1C1 = "Дом"
    oExcel.Range("G10").Select
    oExcel.ActiveCell.FormulaR1C1 = "Кв."
    oExcel.Range("A10:G10").Select
    oExcel.Selection.Font.Bold = True
 
 
With RSset
     ' Задание свойств объекта RSset (Recordset)
     ' Источник: SQL-конструкция
     
    SQLText = "SELECT tblTreatyDetail.TreatyID, tblTreatyDetail.ObjectID, " & _
    " tblAddress.AddressName, tblAddress.AddressSign, tblAddress.AddressFirst, " & _
    " tblObject.House, tblObject.Flat " & _
    " FROM tblTreaty INNER JOIN ((tblAddress INNER JOIN tblObject " & _
    " ON tblAddress.Address = tblObject.Address) INNER JOIN tblTreatyDetail " & _
    " ON tblObject.ObjectID = tblTreatyDetail.ObjectID)" & _
    " ON tblTreaty.TreatyID = tblTreatyDetail.TreatyID " & _
    " WHERE tblTreatyDetail.TreatyID = " & SelectTreatyID & _
    " AND tblTreatyDetail.ObjectID = " & SelectObjectID
    
    .Source = SQLText
     
     ' Указатель на открытое соединение
     .ActiveConnection = CurrentProject.Connection
     .CursorType = adOpenKeyset   ' Тип курсора
     .Open
    End With
     
     If RSset(4) = False Then
   ' Признак адреса стоит первым
   RightAddress = Trim(RSset(3)) & " " & _
                Trim(RSset(2))
    Else
    ' Признак адреса стоит вторым
   RightAddress = Trim(RSset(2)) & " " & _
                Trim(RSset(3))
    End If
 
For I = 0 To RSset.RecordCount - 1
    RSset.Move I, adBookmarkFirst
    oExcel.Range("B" & I + 11 & ":E" & I + 11).Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    With oExcel
    .Range("A" & I + 11).Select
    .ActiveCell.FormulaR1C1 = RSset.Fields(1).Value
    .Range("B" & I + 11 & ":E" & I + 11).Select
    .ActiveCell.FormulaR1C1 = RightAddress
    .Range("F" & I + 11).Select
    .ActiveCell.FormulaR1C1 = RSset.Fields(5).Value
    .Range("G" & I + 11).Select
    .ActiveCell.FormulaR1C1 = RSset.Fields(6).Value
    End With
Next I
 
    
' Переход в начало отчета
oExcel.Range("A1").Select
' Устанавливаем защиту рабочего листа и книги
' Пароль - текущее время
oExcel.ActiveSheet.Protect ("' + Time() + '")
oExcel.ActiveWorkbook.Protect ("' + Time() + '")
RSset.Close
Set RSset = Nothing
End Sub
В чем может быть ошибка? И, есть советы как сделать форматирование этой таблицы (границы)?

БД Access 2010:
47 Маслов 5.rar
0
Лучшие ответы (1)
Сообщение: #10430077
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
 13.05.2017, 06:15
Ответы с готовыми решениями:

Почему не работает цикл while для заполнения и do while для вывода массива?
//--------------------------------------------------------------------------- #include <vcl.h> #include <conio.h> #include...

Задать цикл вывода последующих записей начиная с 6-й
Простой цикл используется плагином: <?php if (have_posts()) : ?> <?php while (have_posts()) : the_post(); ?> ...

Синхронизация записей Excel и Access
Как синхронизировать таблицу Excel в Access, чтобы при открытии Access автоматически обновлялись записи, которые добавляются в Excel.

6
4 / 4 / 0
Регистрация: 01.03.2016
Сообщений: 139
13.05.2017, 06:21  [ТС]
Прощу прощения, залил не тот архив:
47 Маслов 5.rar
0
 Аватар для Alex77755
11525 / 3812 / 683
Регистрация: 13.02.2009
Сообщений: 11,229
13.05.2017, 08:01
Лучший ответ Сообщение было отмечено vasya_27 как решение

Решение

нет 2010 офиса - не могу открыть.
так визуально:
перед перебором записей
Visual Basic
1
2
3
4
5
6

RSset.novelast
RSset.movefirst
For I = 0 To RSset.RecordCount - 1
''''' действия
RSset.movenext
next i
убрать все select! просто:
Visual Basic
1

 .Range("A" & I + 11)= RSset.Fields(1).Value
Добавлено через 5 минут
форматирование этой таблицы (границы)
Для всей таблицы границы примерно так
Visual Basic
1

oExcel.Range("A1").resize(RSset.RecordCount+11,5).borders.linestyle=1
5 - количество колонок.
А вообще в коде процентов 90 лишнего
1
4 / 4 / 0
Регистрация: 01.03.2016
Сообщений: 139
13.05.2017, 09:56  [ТС]
Alex77755, добавил мувы, ничего не изменилось, также одна строка выводится...
0
4 / 4 / 0
Регистрация: 01.03.2016
Сообщений: 139
13.05.2017, 10:12  [ТС]
Почему то RSCount = 1^. Что это может быть?
0
4 / 4 / 0
Регистрация: 01.03.2016
Сообщений: 139
13.05.2017, 10:33  [ТС]
Покопал запрос, проблема решилась. Осталось придумать как форматирование в этом цикле сделать...
0
 Аватар для Alex77755
11525 / 3812 / 683
Регистрация: 13.02.2009
Сообщений: 11,229
14.05.2017, 08:16
как форматирование в этом цикле сделать...
Почему в цикле? проще же в конце всю таблицу сразу
в цикле как-то так:
Visual Basic
1
2
3
4
5
6
7
8

    With oExcel
    .Range("B" & i + 11 & ":E" & i + 11).Merge
    .Range("A" & i + 11) = RSset.Fields(1).Value
    .Range("B" & i + 11 & ":E" & i + 11) = RightAddress
    .Range("F" & i + 11) = RSset.Fields(5).Value
    .Range("G" & i + 11) = RSset.Fields(6).Value
    .Range("A" & i + 11).Resize(, 7).Borders.LineStyle = 1
    End With
1
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
 14.05.2017, 08:16
Помогаю со студенческими работами здесь

Не работает цикл вывода дат в интервале
Здравствуйте. Вроде бы не сложная задача, но не могу разобраться что не так. Суть задачи кратко: в обработке получаю список сотрудников и...

Экспорт записей из таблиц access в excel и наоборот
Здравствуйте, уважаемые участники! Стоит такая задача: Необходимо экспортировать записи из таблиц Access в Excel, а затем из Excel в...

Экспорт записей из таблиц access в excel и наоборот
Здравствуйте, уважаемые участники! Стоит такая задача: Необходимо экспортировать записи из таблиц Access в Excel, а затем из Excel в...

MS Access: редактирование, добавление, удаление записей и экспорт в Excel
Есть база данных сделанная в access нужно написать приложение с граф интерфейсом, из которого могли 1 заполнить БД (для каждой ячейки бд...

Возможен ли импорт записей из Access (поля) в Excel (в ячейку) без VBA ?
если есть - то как это можно сделать? Везде - где не натыкаюсь - везде использование VBA. С стандартными функциями импорта из Access...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Новые блоги и статьи
SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств
8Observer8 07.02.2026
Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .
SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве
8Observer8 02.02.2026
Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .
Философия технологии
iceja 01.02.2026
На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .
SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf
8Observer8 01.02.2026
Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .
SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли
8Observer8 31.01.2026
Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .
SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm
8Observer8 30.01.2026
Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .
SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров
8Observer8 29.01.2026
Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .
Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT
bedvit 28.01.2026
Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru