Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Access
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.12.2015, 06:08   #1
evdss
Пользователь
 
Регистрация: 12.10.2010
Сообщений: 66
По умолчанию вывод в exlel нужное количество строк

Добрый день! Подскажите, пожалуйста, как вывести в файлы Excel по 25 строк по шаблону. Сейчас выводится все данные в один, т.е если прошли в источнике 25 строк сохраняем в файл 1, далее следующие 25 в файл 2 и т.д
'Объявляем переменные

Private Sub Кнопка3_Click()
Dim XL As Object
Dim XLT As Object
Dim newrow As Object
Dim db As Database
Dim qr As QueryDef
Dim rsd As DAO.Recordset
Dim strPathExcel As String

Dim strSQL As String
Set qr = CurrentDb.QueryDefs("запрос1")
'Запрос к базе данных
strSQL = qr.SQL
qr.Close
Set rsd = CurrentDb.OpenRecordset(strSQL)
'Создаем необходимые объекты
Set XL = CreateObject("Excel.Application")
Set XLT = XL.Workbooks.Open("C:\pismo\dot\рее стр.xltx")
strPathExcel = CurrentProject.Path & "\reestr\" & "reestr.xls"
Rowss = 10
numrow = 1
'запускаем цикл до тех пор, пока не закончатся строки в нашем источнике

While Not (rsd.EOF)

'смотрим, если строк больше чем мы задали в шаблоне
If Rowss >= 10 Then
'то добавляем строку
XLT.Worksheets("Лист1").Rows(Rowss) .Insert
'Запомним нашу строку
Set newrow = XLT.Worksheets("Лист1").Rows(Rowss)

XLT.Worksheets("Лист1").Rows(Rowss - 1).Copy newrow

'динамически формируем адрес нужной ячейки
Cell = "a" & Rowss
'и задаем ей значение
XLT.Worksheets("Лист1").Range(Cell) = numrow
Cell = "b" & Rowss
XLT.Worksheets("Лист1").Range(Cell) = rsd.Fields("Кому:").Value & " " & rsd.Fields("Куда:").Value
'переходим на следующую строку
Rowss = Rowss + 1
numrow = numrow + 1
Else
'а это выполняется до тех пор, пока не закончатся заданные строки в шаблоне
'т.е. если строк в источнике всего 1 то в код, который выше мы даже не попадем
Cell = "a" & Rowss
XLT.Worksheets("Лист1").Range(Cell) = numrow
Cell = "b" & Rowss
XLT.Worksheets("Лист1").Range(Cell) = rsd.Fields("Кому:").Value & " " & rsd.Fields("Куда:").Value
Rowss = Rowss + 1
numrow = numrow + 1
' rsd.MoveNext
End If


rsd.MoveNext
'конец цикла
Wend

'делаем Excel видимым

XLT.SaveAs strPathExcel

XL.Visible = True
'Очищаем переменные
Set XL = Nothing
Set XLT = Nothing
Set newrow = Nothing

End Sub

Последний раз редактировалось evdss; 03.12.2015 в 06:21.
evdss вне форума Ответить с цитированием
Старый 03.12.2015, 09:46   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

я б делал, наверно, так:
В части перед
Код:
Wend
поставить счетчик строк. Если набилось 25 строк: сохранить_как, открыть шаблон, сгенерировать_новое_strPathExcel, обнулить счетчик строк, пойти на следующую итерацию
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 03.12.2015, 11:15   #3
evdss
Пользователь
 
Регистрация: 12.10.2010
Сообщений: 66
По умолчанию

Спасибо, попробую.
evdss вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Выровнять текст по правому краю,добавив в начало непустой строки нужное количество пробелов f1x Паскаль, Turbo Pascal, PascalABC.NET 19 21.12.2012 10:36
Определить количество строк в максимальном множестве попарно непохожих строк заданной матрицы Cи/С++ FleXt Помощь студентам 12 17.12.2012 14:42
Сканирования строк. Зная количество строк и первый элемент, это количество символов с троке. dimon9 Общие вопросы C/C++ 8 02.11.2012 22:40
Ввести последовательность строк. Подсчитать количество совпадающих строк. на языке SHELL lj23lj Фриланс 1 30.03.2012 16:41
копирование строк нужное количество раз Composter Microsoft Office Excel 2 14.12.2011 23:04