Задача - разложить данные по предприятия в закладки книги файла эксель. Т.е. одна закладка одно предприятие. + имя закладки это имя предприятия из списка. Шапка одна и так же везде должна быть, количество предприятий может меняться. Для вывода отчет использую шаблон и компоненту EXLReport. В один список все прекрасно выходит, а вот как разбить на страницы с именами предприятий и данные разложить вопрос. Не уверен, что верно написал переход по списку предприятий еще... Вот пример моего вывода:
ClientDataSet1.First; while not ClientDataSet1.Eof do begin sPlace := ClientDataSet1.FieldByName('Pr_MEST').AsString; if Ls.IndexOf(sPlace) = -1 then begin Ls.Add(sPlace); end; ClientDataSet1.Next; end;
for i := 0 to Pred(Ls.Count) do begin ClientDataSet1.Filtered := False; ClientDataSet1.Filter := 'Pr_MEST = ' + QuotedStr(Ls.Strings[i]); ClientDataSet1.Filtered := True;
Data := VarArrayCreate([1, ClientDataSet1.RecordCount, 1, 3], varVariant);
ClientDataSet1.First; iRec := 0; while not ClientDataSet1.Eof do begin
Нужные поля допишешь, если понадобится - поменяешь диапазон на листе, куда будет копироваться информация. Датасет вот такой: Нажмите для просмотра прикрепленного файла , все корректно разбивается на 5 листов.
Atreides
28.04.2011 8:57
XLApp - это ExcelApplication или какой модуль надо подключить? Закладки как имя предприятия принимаются, и в каком месте запрос открывать? Есть возможность использовать шапку и после эту шапку копировать на другие листы? вылетаю по ошибке [DCC Error] Print.pas(360): E2010 Incompatible types: 'TExcelApplication' and 'IDispatch' - несовместимые типы на строке XLApp := CreateOleObject('Excel.Application');
IUnknown
28.04.2011 10:05
Цитата
XLApp - это ExcelApplication или какой модуль надо подключить?
Нет. Это
Uses ..., ComObj;
var XLApp : Variant;
Цитата
Закладки как имя предприятия принимаются, и в каком месте запрос открывать?
Еще раз можно этот же вопрос задать, только в более понятной форме? Какой запрос? Запрос - в строке
Если тебе нужно - задай там критерием фильтрации не только поле Pr_MEST, но и любую другую комбинацию условий по правилам SQL.
Цитата
Есть возможность использовать шапку и после эту шапку копировать на другие листы?
Есть возможность новый лист добавлять из шаблона. Прямо с шапкой, в том формате, который тебе нужен:
const TemplateSheet = 'F:\Programs\Delphi\XLL\Sheet1.XLT'; // В этом шаблоне только один лист, с шапкой которая тебе нужна
var XLApp : Variant;
procedure TForm1.Button2Click(Sender: TObject);
var workBooks, activeBook, curr, Range : Variant; CellStart, CellFinish : Variant; sPlace : String; Ls : TStringList; i, iRec : Integer; Data : Variant; begin XLApp := CreateOleObject('Excel.Application'); XLApp.Visible := True; XLApp.SheetsInNewWorkbook := 1; // Добавим не 3 (по умолчанию), а 1 лист
// Ну, дальше все ПОЧТИ без изменений ClientDataSet1.First; while not ClientDataSet1.Eof do begin sPlace := ClientDataSet1.FieldByName('Pr_MEST').AsString; if Ls.IndexOf(sPlace) = -1 then begin Ls.Add(sPlace); end; ClientDataSet1.Next; end;
for i := 0 to Pred(Ls.Count) do begin ClientDataSet1.Filtered := False; ClientDataSet1.Filter := 'Pr_MEST = ' + QuotedStr(Ls.Strings[i]); ClientDataSet1.Filtered := True;
Data := VarArrayCreate([1, ClientDataSet1.RecordCount, 1, 3], varVariant);
ClientDataSet1.First; iRec := 0; while not ClientDataSet1.Eof do begin
// А вот и изменения: добавляем новый личт из шаблона ПОСЛЕ того, что был текущим Curr := ActiveBook.Sheets.Add (Type := TemplateSheet, After := Curr); Curr.Name := Ls.Strings[i]; CellStart := Curr.Cells[2, 1]; // Ну, и корректируем позицию вставки (* Я для пробы создал шаблон только с одной строкой, поэтому позицию начала вставки перенес на 1 строку ниже. Если у тебя в шаблоне 20 строк шапки - то соответственно, сделаешь
CellStart := Curr.Cells[21, 1];
Ну, и сдвинуть столбец тоже можно при желании... *) CellFinish := Curr.Cells[iRec + 1, 3]; // Здесь тоже не забывай вносить изменения, одновременно с предыдущей строкой
Range := Curr.Range[CellStart, CellFinish]; Range.Value := Data;
VarClear(Data); end;
finally Ls.Free; end; ActiveBook.Sheets[1].Delete; // Помнишь первый добавленный лист? Он не нужен... end;
В комментариях описаны все изменения, которые надо внести... Код тестировался на Дельфи 2009 под Excel XP, но ничего страшного и при более новых версиях Офиса произойти не должно, ничем недокументированным я не пользуюсь, все описано в MSDN -> Microsoft.Office.Interop.Excel Namespace (ссылки пока добавлять не могу, так что ищи сам)
Atreides
28.04.2011 15:20
меня интересует вопрос в каком месте послать запрос и вставлять конструкцию следующего типа или она вообще не нужна?
Код
st := ' select ..... '; Form5.ClientDataSet1.close; Form5.ClientDataSet1.DataRequest(st); Form5.ClientDataSet1.open;
Запросом я выдаю весь список данных сгруппированные по предприятиям. Вот мне в закладку надо название организации вкрячить. Т.е. есть организация и на листе все записи с ней, на другом листе все записи по второй и так далее...
IUnknown
28.04.2011 15:44
Цитата
меня интересует вопрос в каком месте послать запрос и вставлять конструкцию следующего типа или она вообще не нужна?
Заметил? Сначала проходим по всей базе и заносим все разные данные из полей "Pr_MEST" в StringList... А потом просто фильтруем данные из набора: каждый раз подставляя новое значение из List-а в фильтр. Я структуры твоего набора данных не знаю. Предположил, что в поле "Pr_MEST" хранится название организации. Если так - то прекрасно. Не так - замени название поля на нужное в двух местах: в строке 33 и строке 44 исходника из 4-го поста. В 44-ой строке набор будет фильтроваться по нужному критерию, и данные для одной организации запишутся на один лист отчета, для другой - на другой лист. Для тех данных, что я показал - получился вот такой результат: Нажмите для просмотра прикрепленного файла
Тебе что, присоединить полный исходник? Сам заполнить ClientDataSet так, как на скриншоте из 2-го поста, и проверить, что происходит при запуске программы - не можешь?
Цитата
Вот мне в закладку надо название организации вкрячить.
Цитата
Curr := ActiveBook.Sheets.Add (Type := TemplateSheet, After := Curr); Curr.Name := Ls.Strings[i]; // <--- Эту строчку видел? Что она делает?
Atreides
28.04.2011 16:01
наверное, лучше исходник прикрепить как целостны пример, его по-кусочкам разбирать буду.
Поменяешь там путь к XLT-файлу на правильный... Сначала жмешь кнопку "FillDSet", датасет заполнится (я не стал делать соединения с БД, заполнил все в рантайме. Разницы в обработке данных - никакой, а проблем меньше), а потом - "To XL"
Atreides
29.04.2011 11:49
Почему то в конце столбцов образуются символы (#Н/Д). Чет более трех полей не получается вывести, а мне надо 14
IUnknown
29.04.2011 12:32
Цитата
Почему то в конце столбцов образуются символы (#Н/Д).
Значит, размер области
Цитата
Range := Curr.Range[CellStart, CellFinish];
вычислил неправильно. Такое бывает когда ты, скажем, заполняешь массив на 3 столбца и 20 строк, а указываешь Экселю, что перенести его надо в область из трех столбцов и 21 строки. Естественно, Эксель недополучает данные, и все, что недополучил - считает #Н/Д. Где-то у тебя лишняя единица затесалась.
Цитата
Чет более трех полей не получается вывести, а мне надо 14
Хоть 114. Инициализируй Data нужного размера (столбцы - это 3 и 4 индексы)
Data := VarArrayCreate([1, ClientDataSet1.RecordCount, 1, 14], varVariant); // Будет тебе место под 14 столбцов
, и заполняй значениями. А потом переноси, только начальную/конечную ячейки правильно посчитай...
Atreides
29.04.2011 12:38
Код
Data := VarArrayCreate([1, ClientDataSet1.RecordCount, 1, 14], varVariant); // Будет тебе место под 14 столбцов
Значит я верно разобрался. Косякнул в другом месте ((( А еще такой вопрос, при выполнении происходит открытие экселя и его заполнение, а можно заполнить, а поле отобразить?
IUnknown
29.04.2011 12:59
Можно. Перенеси
ActiveBook.Sheets[1].Delete; // Помнишь первый добавленный лист? Он не нужен... XLApp.Visible := True; // <--- Вот сюда строку из начала процедуры
Где будет Visible присваиваться True - там и будет появляться окно Excel. Но тогда тебе надо будет добавить какой-нибудь ProgressBar (скажем, по количеству обработанных предприятий), потому что если отчет сложный (много данных), то между нажатием на кнопку и получением результата пройдет какое-то время, пользователь может быть в недоумении.
Atreides
2.05.2011 11:30
Еще вопрос такой возник – можно добавить вставку даты в шапку, в заранее заданную ячейку и итог общий по сумму в конце дописать?
IUnknown
2.05.2011 13:33
Цитата
можно добавить вставку даты в шапку, в заранее заданную ячейку и итог общий по сумму в конце дописать?
Если ячейка известна - то разумеется, можно:
ToCell := 'A3'; // Var ToCell : String; ActiveBook.Sheets[1].Range[ToCell] := Твои_Данные; // Можешь записать и на другой лист.
- Подставишь свой интервал в формулу, и нужный номер ячейки...
Atreides
3.05.2011 13:55
Из константы можно путь в переменную вывести?
IUnknown
3.05.2011 14:08
Из константы в переменную - можно, обратно - нельзя.
Atreides
3.05.2011 14:33
Цитата(IUnknown @ 3.05.2011 15:08)
Из константы в переменную - можно, обратно - нельзя.
Код
var TemplateSheet:string; begin TemplateSheet := 'H:\M6301.XLs'; end;
Чет не прокатывает мне. Чет не так делаю (((
IUnknown
3.05.2011 14:51
Что значит "не прокатывает"? Все прекрасно скомпилировалось и отработало.
Atreides
3.05.2011 14:59
Цитата(IUnknown @ 3.05.2011 15:51)
Что значит "не прокатывает"? Все прекрасно скомпилировалось и отработало.
[DCC Error] Print.pas(452): E2029 ':=' expected but '=' found - посылает по этому в этой строке((
Код
begin TemplateSheet = 'H:\808.COM\Andreev\Справочники\Формы\M6301.XLs'; end;
IUnknown
3.05.2011 15:03
Ну, а какого ты сверху написал ":=", а здесь, ниже, уже пишешь "="? Требуется-то именно присваивание, переменная же...
TarasBer
3.05.2011 15:32
Бесят уже. Сами по невнимательности всё партачат, а потом то "твой код глючит", то "у меня не компилируется".
Atreides
3.05.2011 15:55
Цитата(IUnknown @ 3.05.2011 16:03)
Ну, а какого ты сверху написал ":=", а здесь, ниже, уже пишешь "="? Требуется-то именно присваивание, переменная же...
уже разобрался, не стал отписывать... Признаю мой косяк.
Atreides
4.05.2011 14:21
1. После завершения работы, остается висящий процесс в диспетчере задач, после накапливаются там и тормозят работу, приходиться в ручную убивать процессы. 2. При повторном обращении к выдаче отчета вылетает ошибка, что ClientDataSet не может найти поле Kodorg. Приходиться закрывать и заново открывать прожку. Хотя прописал закрытие ClientDataSet после открытия эксельного файлика.
IUnknown
4.05.2011 15:11
Цитата
Попробовал так, заполняется неплохо, но с отставанием на 1 лист, ибо первый код вписывается на первый лист – пустой и не удаляется.
Разумеется. Ты ж записываешь данные еще ДО создания листа, куда пишется массив Data. Перенеси эту строку куда-нибудь ниже
Curr := ActiveBook.Sheets.Add (Type := TemplateSheet, After := Curr); // Вот этой строки
- "отставания" не будет... Да, ToCell3 присваивать новое значение надо тоже после Add-а уже, ибо ячейка - на новом листе...
Цитата
2. После завершения работы, остается висящий процесс в диспетчере задач, после накапливаются там и тормозят работу, приходиться в ручную убивать процессы.
Завершай Excel корректно - не будет оставаться:
ActiveBook.Sheets[1].Delete; // Это я уже показывал XLApp.Workbooks[1].SaveAs(ReportName); // <--- Сохраняем куда надо XLApp.Quit; // <--- И убираем из процессов XLApp := Unassigned;
Atreides
4.05.2011 15:32
Цитата(IUnknown @ 4.05.2011 16:11)
Разумеется. Ты ж записываешь данные еще ДО создания листа, куда пишется массив Data. Перенеси эту строку куда-нибудь ниже
Curr := ActiveBook.Sheets.Add (Type := TemplateSheet, After := Curr); // Вот этой строки
- "отставания" не будет... Да, ToCell3 присваивать новое значение надо тоже после Add-а уже, ибо ячейка - на новом листе...
Да и снова я погорячился и буквально после поста сам исправил.
IUnknown
4.05.2011 15:53
Цитата
Хотя прописал закрытие ClientDataSet после открытия эксельного файлика.
И после этого удивляешься,
Цитата
что ClientDataSet не может найти поле Kodorg
??? А как ты хотел, чтоб при закрытом наборе данных что-то находилось? "Фантастика - в следующем зале" (С) Все, что тебе надо сделать после захода в процедуру - это сбросить признак фильтрации, чтоб начиналась работа с нефильтрованным набором. Потом, когда понадобится, фильтрация опять будет включена...
ClientDataSet1.Filtered := False;
, закрывать ничего не надо...
Atreides
6.05.2011 7:24
Никак не могу найти ошибку, на каждой странице не хватает по три записи, где теряются не понимаю. Так же иногда получается, что данные вписываются в шапку, заполняют собой шапку и на этом появляется запись #НД
if Form5.ClientDataSet1.RecordCount = 0 then begin ShowMessage('Записи отсуствуют'); end else begin XLApp := CreateOleObject('Excel.Application'); // XLApp.Visible := True; XLApp.SheetsInNewWorkbook := 1; // Добавим 1 лист - 3 (по умолчанию)
ClientDataSet1.First; while not ClientDataSet1.Eof do begin sPlace := ClientDataSet1.FieldByName('Kodorg').AsString; if Ls.IndexOf(sPlace) = -1 then begin Ls.Add(sPlace); end; ClientDataSet1.Next; end;
for i := 0 to Pred(Ls.Count) do begin ClientDataSet1.Filtered := False; ClientDataSet1.Filter := 'Kodorg = ' + QuotedStr(Ls.Strings[i]); ClientDataSet1.Filtered := True;
Data := VarArrayCreate([1, ClientDataSet1.RecordCount, 1, 14], varVariant); ClientDataSet1.First; iRec := 0; while not ClientDataSet1.Eof do begin
// добавляем новый личт из шаблона ПОСЛЕ того, что был текущим Curr := ActiveBook.Sheets.Add(type := TemplateSheet, After := Curr); Curr.Name := Ls.Strings[i];
на каждой странице не хватает по три записи, где теряются не понимаю.
Я тебе объясню...
Вот тут:
Цитата
CellStart := Curr.Cells[12, 1]; CellFinish := Curr.Cells[iRec + 8, 14]; // корректировка позиции вставки Range := Curr.Range[CellStart, CellFinish];
ты что-то намудрил. Если начальная позиция - строка №12, первый столбец, то для того, чтоб занести iRec строк и 14 столбцов, надо конечную позицию считать так:
CellFinish := Curr.Cells[12 + iRec - 1, 14];
, у тебя же отчет данные недоговаривает.
Насчет разных непредвиденных значений... У тебя, насколько я вижу, есть несколько полей типа ftData? Так вот, когда поле типа ftString переносится в Excel, и ему не хватает ширины столбца, чтоб полностью показаться, ничего страшного не происходит: показывается часть строки, а часть - отрезается. Совсем другое дело с ftData: если ему не хватает ширины столбца - то отображается #####, надо изменять ширину столбца. Как только изменишь, и этой ширины хватит - покажется дата.
#НД в шапке? Прогнал программу раз 15, с разными данными в ClientDataSet - ни разу в шапку ничего не залезло. Да и не может, в принципе, если ты поправишь вычисление CellFinish. Если все-же поймаешь такое поведение - скажи, сколько было записей в ClientDataSet на тот момент, когда переносились данные, я попробую сгенерировать набор с таким же количеством данных и проверить поведение у себя. И еще: желательно было бы иметь информацию, в каких именно ячейках появляется #НД
Atreides
11.05.2011 14:47
Поправка на поля исправила ошибку с не хватающими записями и шапкой. Записей у меня 9548 штук. )) Возникла трудность - как экселю сообщить, что в ячейку пишется формула, а не просто текст. Написал формулу подсчета сумм, но отображается формула, если нажать энтер, то нормально сумма отображается, а так ток "#ИМЯ?". Это у меня по общей сумме.
И еще можно цикл сделать, например на каждой закладке у меня по данным есть поле с формами (они упорядочены у меня запросом от меньших к большим). Как только появилась новое значение ( к примеру с 6 сменилось на 7) то отписать под ними строку итого и сумму и продолжить вывод данных?
IUnknown
11.05.2011 15:07
Цитата
как экселю сообщить, что в ячейку пишется формула, а не просто текст.
Логично? По крайней мере, на англоязычном Оффисе вот такой код работает прекрасно: Curr.Range['A11'].Formula := '=Sum(A1:A10)';
Цитата
например на каждой закладке у меня по данным есть поле с формами (они упорядочены у меня запросом от меньших к большим). Как только появилась новое значение ( к примеру с 6 сменилось на 7) то отписать под ними строку итого и сумму и продолжить вывод данных?
Не понял. Это в тех данных, которые ты из Дельфи перетягивал, или ты еще что-то свое делаешь в этих закладках? Если то, что из Delphi - то прямо при заполнении массива Data это желательно делать. Хотя, конечно, можно и потом пробежаться по содержимому листа, и проверить, где меняется значение в определенном поле. Тебе для этого даже сумму считать не придется, достаточно только знать, в каком ряду это значение началось, и в каком - заканчивается. В общем, приведи пример, как у тебя на листе данные располагаются, и что с ними надо сделать...
Atreides
12.05.2011 7:44
С формулами разобрался, отлично подсчитал общие итоги. Кинул пример файлика с итогами, которые мне нужны, выделил красным. Т.е на каждой закладке внизу заполнить итоги по каждому наименованию с отдельной формой и суммой, и общий итог по всем.
IUnknown
12.05.2011 9:15
Цитата
Или, наверное, проще вариант, это пройти по листу и посчитать суммы по одинаковым значения форм и вывести внизу рядом с общим итогом.
Так действительно будет проще. Уже потому, что если будешь вставлять суммы в середину таблицы, общий итог будет изменяться.
Понимаешь идею? То есть, тебе достаточно на лист забросить несколько (по числу разных форм) ячеек с формулами. Формулы - почти одинаковые, разница - только в среднем поле, для N26 из моего примера, это =SUMIF(B12:B22, M26, N12:N22). А рядом, слева (ну, это уже по желанию, можно и справа ) собственно, для какой формы это все считается. Формула одна, результаты - разные.
Atreides
12.05.2011 14:18
а как же исключать ячейки и определять начало новых значений
IUnknown
12.05.2011 15:40
Когда ж ты сам начнешь думать?
Вот идея прохода по листу с заполнением сумм по формам:
procedure TForm1.Button9Click(Sender: TObject); const StrFormula = '=SUMIF(B12:B%d, M%d, N12:N%d)'; var XLApp : Variant; Sh : Variant; start, lastCell, Last : Integer; prevCell, currCell : string;
begin XLApp := CreateOleObject('Excel.Application'); XLApp.Visible := True; XLApp.Workbooks.Open('F:\test\1.xls'); // Это тот файл, который ты высылал первым...
Sh := XLApp.Sheets[2]; LastCell := 25; // Это надо будет вычислить автоматически, но это уже самостоятельно ...
Last := LastCell;
start := 12; prevCell := Sh.Cells[start, 2]; for start := 12 to LastCell - 1 do begin currCell := Sh.Cells[start, 2]; if currCell <> prevCell then begin Sh.Cells[last + 1, 14].Formula := Format(StrFormula, [LastCell - 1, Last + 1, LastCell - 1]); Sh.Cells[last + 1, 13] := prevCell; inc(last); prevCell := currCell; end; end;
Благодарю! Выходит даже не обязательно искать эти значения, просто надо выписать уже значения и после просто формулу подставлять. Снова очередная моя невнимательность. а если мне надо два критерия выбора, просто через запятую указать?
IUnknown
13.05.2011 10:38
Это то есть как 2 критерия? Пример можно привести? Вот есть у меня твой файл, какие 2 критерия ты хочешь добавить для вычисления частичных сумм? Один критерий - понятно, какое-то поле совпадает с нужным значением. Второй какой?
Atreides
13.05.2011 12:02
По наименованию и по форме. Родилась идея запросом получать записи наименований и форм по distinct, записать их в эксель и к ним уже формулки подписать.
IUnknown
13.05.2011 12:12
Я ж просил пример привести... Еще раз: я понимаю, когда у тебя есть один критерий, и ты печатаешь: для формы = "11" сумма = столько_то, для "4У" - столько_то... Как сюда втюхать еще и наименование? Как сумму вычислять, расскажи? Отдельно для разных форм, отдельно для разных наименований - пожалуйста, но это не 2 критерия, а две разные формулы, каждая с одним критерием.
Atreides
17.05.2011 11:10
Под данными надо подвести итоги по суммам и количеству. Итоги считать надо по типу по всем формам с наименованиями не повторяющимися, т.е. Там есть Самара 4У и должна быть Самара 11, так же и с БШШП 4У и БШШП 11. Вот и получается два критерия поиска вычисления сумм
IUnknown
17.05.2011 12:43
А для комбинирования нескольких условий в Excel есть array formulas, то есть, формулы, работающие с массивами. Пишешь формулу:
Идея понятна, да? Изменяя номера ячеек после знака равенства, получишь все нужные критерии... Если надумаешь проверить как это работает и будешь вводить формул в самом Excel-е, то учти, что array formula вводится не просто Enter-ом, а Ctrl+Shift+Enter...
Гость
23.05.2011 14:59
В целом разобрался, но тут посидел голову поломал написал все тоже запросом. Вот если второй ClientDataSet повесить с запросом и на тот же фильтр завязать можно?
Atreides
23.05.2011 15:01
Цитата(Гость @ 23.05.2011 15:59)
В целом разобрался, но тут посидел голову поломал написал все тоже запросом. Вот если второй ClientDataSet повесить с запросом и на тот же фильтр завязать можно?
Это я был.
IUnknown
23.05.2011 17:46
Не знаю, тебе решать. Ты свой запрос видишь, а я - не телепат.
Да и поднадоело уже мне: тебе говоришь, как делать, ты тут же берешь и переделываешь по-своему. Ну, так делай дальше по-своему. Лепи одно на другое. Когда надо будет программу отлаживать и поддерживать - вот тогда вспомнишь, что тебе советовали...
Atreides
24.05.2011 7:22
В любом случае огромное спасибо, за помощь!
Atreides
3.06.2011 7:39
А можно ячейки задать типа данных программных путем, не в шаблоне.
Atreides
1.07.2011 16:56
столкнулся с такой проблемой, когда у меня записей больше 300, формат данных начинает менятся на общий или какой угодно экселю и теряется форматирование в ячейке. пробовал заранее задавать формат через
результата не принесло. Кто сталкивался, подскажите как быть?
procedure TForm5.BitBtn3Click(Sender: TObject); var workBooks, activeBook, curr, Range: Variant; CellStart, CellFinish: Variant; sPlace: string; Ls: TStringList; i, iRec: Integer; Data: Variant; st, st2, st3: string; col: integer; year, MonthSelected: string; oth: string; direct: string; IDSOURCE, PR_MEST: string; priznak: string; NO_FAM: string; ID_TRAN: string; ToCell, ToCell2, ToCell3, ToCell4, ToCell5, ToCell6, ToCell7, ToCell8, ToCell9, ToCell10, ToCell11, ToCell12, ToCell13, ToCell14, ToCell20, ToCell21, ToCell22: string; value, value2: string; mesto: string; nametext: string; TemplateSheet: string; perevoz: string; st_perevoz: string; IDPEREVOZ: string; position: string; irec_1: integer; V_ar: OleVariant; WorkBk: _WorkBook; // определяем WorkBook WorkSheet: _WorkSheet; // определяем WorkSheet //Range:OleVariant;// begin begin if Form5.Edit1.Text = '' then begin ShowMessage('Введите Год'); end else if Form5.ComboBox1.ItemIndex = (-1) then begin ShowMessage('Выберите месяц'); end else if Form5.ComboBox2.ItemIndex = (-1) then begin ShowMessage('Выберите Наименование'); end else // if Form5.ComboBox3.ItemIndex = (-1) then // begin // ShowMessage('Выберите признак принадлежности'); // end // else if Form5.ComboBox4.ItemIndex = (-1) then begin ShowMessage('Выберите признак места'); end else begin ToCell := 'C1'; // Var ToCell : String; ToCell2 := 'A6'; ToCell3 := 'B8'; value := Form5.ComboBox1.Text + ' ' + Form5.Edit1.Text + ' г.'; value2 := DateTimeToStr(Now); ID_TRAN := Form5.ComboBox2.Text; mesto := IntToStr(Form5.ComboBox4.ItemIndex); year := Form5.Edit1.Text; MonthSelected := FloatToStr(Form5.ComboBox1.ItemIndex + 1); priznak := IntToStr(Form5.ComboBox3.ItemIndex + 1); begin if Form5.ComboBox3.ItemIndex <> -1 then begin priznak := ' and lor.pr_attrib=' + IntToStr(Form5.ComboBox3.ItemIndex + 1); end else begin priznak := ' '; end; end; begin if Form5.ComboBox5.ItemIndex <> -1 then begin IDPEREVOZ := 'select ID_PRIGCOMP from SPR_PRIGCOMP where Full_name=' + #39 + Form5.ComboBox5.Text + #39 + ''; Form5.ClientDataSet1.close; Form5.ClientDataSet1.DataRequest(IDPEREVOZ); Form5.ClientDataSet1.open; IDPEREVOZ := Form5.ClientDataSet1.fieldbyname('ID_PRIGCOMP').asstring; perevoz := ' and l.ID_PEREVOZ=' + #39 + IDPEREVOZ + #39 + '' end else begin perevoz := ' '; end; end; oth := 'select ID_OTCHM from sprotchmonth where YEAROTCH = ' + year + ' and MONTHOTCH = ' + MonthSelected + ''; Form5.ClientDataSet1.close; Form5.ClientDataSet1.DataRequest(oth); Form5.ClientDataSet1.open; oth := Form5.ClientDataSet1.fieldbyname('id_otchm').asstring; st := 'select ID_TRANS from SPR_TRANS t where t.NAME_TRANS=' + #39 + ID_TRAN + #39 + ''; Form5.ClientDataSet2.close; Form5.ClientDataSet2.DataRequest(st); Form5.ClientDataSet2.open; ID_TRAN := Form5.ClientDataSet2.fieldbyname('ID_TRANS').asstring; IDSOURCE := 'select * from SPR_TRANS t, SPRSOURCEDATA s where ' + ' t.Id_Trans =' + #39 + ID_TRAN + #39 + ' and t.Id_Trans=s.Id_Trans and s.Pr_Mest=' + #39 + mesto + #39 + ''; Form5.ClientDataSet1.close; Form5.ClientDataSet1.DataRequest(IDSOURCE); Form5.ClientDataSet1.open; IDSOURCE := Form5.ClientDataSet1.fieldbyname('ID_SOURCE').asstring; PR_MEST := Form5.ClientDataSet1.FieldByName('Pr_MEST').AsString; NO_FAM := Form5.ClientDataSet1.FieldByName('NO_ONE_FAM').AsString; nametext := Form5.ClientDataSet1.FieldByName('NAMETEXT').AsString; begin if nametext = 'M6301' then begin TemplateSheet := 'H:\m6301.xls'; end; if nametext = 'M6302' then begin TemplateSheet := 'H:\ m6302.xls'; end; end; { IDSOURCE := 'select * from Sprsourcedata where SHORT_NAME = ' + #39 + Form5.ComboBox2.Text + #39 + ''; Form5.ClientDataSet1.close; Form5.ClientDataSet1.DataRequest(IDSOURCE); Form5.ClientDataSet1.open; IDSOURCE := Form5.ClientDataSet1.fieldbyname('ID_SOURCE').asstring; PR_MEST := Form5.ClientDataSet1.FieldByName('Pr_MEST').AsString; NO_FAM := Form5.ClientDataSet1.FieldByName('NO_ONE_FAM').AsString; } begin if mesto = '0' then begin st := ' select ' + ' s.SHORT_NAME, l.Kodorg, kod.forma_tt, l.Kodpodr, '; if NO_FAM = '0' then st := st + ' l.FIO ' else st := st + ' (rpad(l.FIO,38) ||rpad(l. FIODEPEN,38)) FIO '; st := st + ' ,l.n_Doclgotn, ' + ' l.Date_Opd, l.Date_Begin_Ab, l.n_Opd, decode(nvl(l.sposob_opd,0),0,''РУЧНОЙ.'',''ЭКСПРЕСС'')Sposob_Opd, ' + ' l.vid_period_ab, l.kol_doc, ' + ' (select msto.namestat from SPR_STATRUS msto where msto.Id_Mstorus=l.Id_Msto_Otpr) STAT_OTPR, ' + ' (select msto.namestat from SPR_STATRUS msto where msto.Id_Mstorus=l.Id_Msto_Nazn) STAT_NAZN, summa, SUMMA_DOP, sysdate ' + ' from LGOTSUMMA l, SPR_PRIGCOMP s, SPR_KODLGOT kod, SPRLORG lor ' + ' where l.Id_Otchm= ' + oth + ' and l.Id_Source=' + IDSOURCE + ' ' + priznak + perevoz + ' and l.id_perevoz = s.id_prigcomp ' + ' and l.kodorg = lor.kodorg ' + ' and kod.kodlgot=l.kodlgot ' + ' order by l.Kodorg, s.SHORT_NAME asc '; Form5.ClientDataSet1.close; Form5.ClientDataSet1.DataRequest(st); Form5.ClientDataSet1.open; st2 := 'select ' + ' l.KODORG, spr.short_name, (''Ф '' || kod.forma_tt) KOD, sum(l.kol_doc) doc , (sum(l.summa)) sum ' + ' from lgotsumma l, SPR_PRIGCOMP spr, SPR_KODLGOT kod, SPRLORG lor ' + ' where l.Id_Otchm= ' + oth + ' and l.Id_Source=' + IDSOURCE + ' ' + priznak + perevoz + ' and spr.id_prigcomp = l.id_perevoz ' + ' and l.kodorg = lor.kodorg ' + ' and kod.kodlgot = l.kodlgot ' + ' group by l.KODORG, spr.short_name, kod.forma_tt ' + ' order by l.Kodorg, spr.short_name, kod.forma_tt asc'; Form5.ClientDataSet2.close; Form5.ClientDataSet2.DataRequest(st2); Form5.ClientDataSet2.open; st3 := 'select l.KODORG, SUM(l.Kol_Doc), sum(l.summa) ' + 'from lgotsumma l, SPR_PRIGCOMP spr, SPR_KODLGOT kod, SPRLORG lor ' + ' where ' + ' l.Id_Otchm= ' + oth + ' ' + ' and spr.id_prigcomp=l.id_perevoz ' + 'and l.kodorg = lor.kodorg ' + ' and kod.kodlgot=l.kodlgot ' + ' and l.Id_Source=' + IDSOURCE + ' ' + priznak + perevoz + ' group by l.KODORG, l.Kol_Doc ' + ' order by l.Kodorg, l.Kol_Doc asc '; Form5.ClientDataSet3.close; Form5.ClientDataSet3.DataRequest(st3); Form5.ClientDataSet3.open; if Form5.ClientDataSet1.RecordCount = 0 then begin ShowMessage('Записи отсуствуют'); end else begin XLApp := CreateOleObject('Excel.Application'); // XLApp.Visible := True; XLApp.SheetsInNewWorkbook := 1; // Добавим 1 лист - 3 (по умолчанию) workBooks := XLApp.WorkBooks; ActiveBook := workBooks.Add; Curr := ActiveBook.Sheets[1]; // Запомним добавленный лист try Ls := TStringList.Create; // заполнение ClientDataSet1.First; while not ClientDataSet1.Eof do begin sPlace := ClientDataSet1.FieldByName('Kodorg').AsString; if Ls.IndexOf(sPlace) = -1 then begin Ls.Add(sPlace); end; ClientDataSet1.Next; end; for i := 0 to Pred(Ls.Count) do begin ClientDataSet1.Filtered := False; ClientDataSet1.Filter := 'Kodorg = ' + QuotedStr(Ls.Strings[i]); ClientDataSet1.Filtered := True; irec_1 := irec_1 + 1; Data := VarArrayCreate([1, ClientDataSet1.RecordCount, 1, 14], varVariant); ClientDataSet1.First; iRec := 0; while not ClientDataSet1.Eof do begin Data[iRec + 1, 1] := ClientDataSet1.FieldByName('SHORT_NAME').AsString; //Curr.Range[iRec + 1, 1].NumberFormat:='##0,00'; Data[iRec + 1, 2] := ClientDataSet1.FieldByName('forma_tt').AsString; Data[iRec + 1, 3] := ClientDataSet1.FieldByName('KODPODR').AsString; Data[iRec + 1, 4] := ClientDataSet1.FieldByName('FIO').AsString; Data[iRec + 1, 5] := ClientDataSet1.FieldByName('n_Doclgotn').AsString; // <---------------- вот этот столбец в числовом формате Data[iRec + 1, 6] := ClientDataSet1.FieldByName('Date_Opd').AsString; Data[iRec + 1, 7] := ClientDataSet1.FieldByName('Date_Begin_Ab').AsString; Data[iRec + 1, 8] := ClientDataSet1.FieldByName('n_Opd').AsString; Data[iRec + 1, 9] := ClientDataSet1.FieldByName('Sposob_Opd').AsString; Data[iRec + 1, 10] := ClientDataSet1.FieldByName('vid_period_ab').AsString; // Range := Sheets.Range['K' + IntToStr(iRec + 1)]; {Range.Borders[4].LineStyle := 1; //Range.Borders[4] - можно ставить от 1 до 8 - точно не мпомню //рисуем border вокруг ячейки (обрамление) // Range := Sheets.Cells[2, 2]; //можно переменные Range:=Sheets.Cells[iRow,iCol]; // Range.HorizontalAlignment := xlCenter; // Range.VerticalAlignment := xlCenter; //Range['K' + IntToStr(iRec + 1)].NumberFormat := '##0'; // Range.NumberFormat := '##0'; } v_Ar := Sheets.Cell['E' + IntToStr(iRec + 1)]; v_ar.HorizontalAlignment := xlRight; v_ar.VerticalAlignment := xlCenter; v_ar.NumberFormat := '##0'; Data[iRec + 1, 11] := ClientDataSet1.FieldByName('kol_doc').AsString; Data[iRec + 1, 12] := ClientDataSet1.FieldByName('STAT_OTPR').AsString; Data[iRec + 1, 13] := ClientDataSet1.FieldByName('STAT_NAZN').AsString; Data[iRec + 1, 14] := ClientDataSet1.FieldByName('SUMMA').AsString; Inc(iRec); ClientDataSet1.Next; end; // добавляем новый личт из шаблона ПОСЛЕ того, что был текущим Curr := ActiveBook.Sheets.Add(type := TemplateSheet, After := Curr); Curr.Name := Ls.Strings[i]; //разметка страницы Curr.PageSetup.PrintArea := 'A1:N' + inttostr(irec + 18); Curr.PageSetup.Zoom := 60; Curr.PageSetup.Orientation := 2; //разметка страницы CellStart := Curr.Cells[12, 1]; // CellFinish := Curr.Cells[iRec + 8, 14]; // корректировка позиции вставки CellFinish := Curr.Cells[12 + iRec - 1, 14]; Range := Curr.Range[CellStart, CellFinish]; Curr.Range[ToCell] := value2; Curr.Range['D12:D' + inttostr(irec + 12)].WrapText := True; // position := IntToStr(irec + 11); ToCell4 := 'A' + inttostr(irec + 18);
begin Form5.ClientDataSet3.First; while not ClientDataSet3.Eof do begin if Ls.Strings[i] = Form5.ClientDataSet3.FieldByName('KODORG').AsString then begin ToCell20 := 'C' + inttostr(irec + 16); Curr.Range[ToCell20].NumberFormat := '##0'; Curr.Range[ToCell20] := Form5.ClientDataSet3.FieldByName('SUM(l.Kol_Doc)').AsString; ToCell21 := 'D' + inttostr(irec + 16); Curr.Range[ToCell21].NumberFormat := '##0,00'; Curr.Range[ToCell21] := Form5.ClientDataSet3.FieldByName('sum(l.summa)').AsString; end; Form5.ClientDataSet3.Next; end; end; { ToCell20 := 'N' + inttostr(irec + 11); Curr.Range[ToCell20].Formula := '=Sum(N12:N' + position + ')'; ToCell21 := 'K' + inttostr(irec + 11); Curr.Range[ToCell21].Formula := '=Sum(K12:K' + position + ')'; } ToCell22 := 'A' + inttostr(irec + 16); Curr.Range[ToCell22] := 'ИТОГО'; ToCell10 := 'A' + inttostr(irec + 13); Curr.Range[ToCell10] := 'Перевозчик'; ToCell11 := 'B' + inttostr(irec + 13); Curr.Range[ToCell11] := 'Форма'; ToCell12 := 'C' + inttostr(irec + 13); Curr.Range[ToCell12] := 'Кол-во.док.'; ToCell13 := 'D' + inttostr(irec + 13); Curr.Range[ToCell13] := 'Сумма'; begin irec_1 := irec + 14; Form5.ClientDataSet2.First; while not ClientDataSet2.Eof do begin // for Ls.Strings[i] := 1 to Ls.Strings[i] - 1 do begin if Ls.Strings[i] = Form5.ClientDataSet2.FieldByName('KODORG').AsString then begin ToCell7 := 'A' + inttostr(irec_1); Curr.Range[ToCell7] := Form5.ClientDataSet2.FieldByName('SHORT_NAME').AsString; ToCell8 := 'B' + inttostr(irec_1); Curr.Range[ToCell8].NumberFormat := '##0'; Curr.Range[ToCell8] := Form5.ClientDataSet2.FieldByName('KOD').AsString; ToCell14 := 'C' + inttostr(irec_1); Curr.Range[ToCell14].NumberFormat := '##0'; Curr.Range[ToCell14] := Form5.ClientDataSet2.FieldByName('DOC').AsString; ToCell9 := 'D' + inttostr(irec_1); Curr.Range[ToCell9].NumberFormat := '##0,00'; Curr.Range[ToCell9] := Form5.ClientDataSet2.FieldByName('SUM').AsString; irec_1 := irec_1 + 1; end; Form5.ClientDataSet2.Next; end; end; end; Curr.Range[ToCell3] := (Ls.Strings[i]); Range.Value := Data; VarClear(Data); end; finally Ls.Free; end; ClientDataSet1.Filtered := False; Form5.ClientDataSet1.close; ActiveBook.Sheets[1].Delete; // удаление первого листа XLApp.Visible := True; // XLApp.Workbooks[1].SaveAs('C:\' + nametext + '.xls'); // <--- Сохраняем куда надо // XLApp.Quit; // <--- И убираем из процессов XLApp := Unassigned;
end.
Lapp
2.07.2011 0:37
М
Ну неужели ТАК СЛОЖНО поставить ПРАВИЛЬНЫЙ тег?.. code=pas
IUnknown
2.07.2011 2:16
Попробую догадаться: значение числовое, но очень длинное, так? То есть, длина - больше 8 цифр? Тогда тебе придется явно указывать, что ты хочешь записать эти данные в ячейку как текст:
Теперь этот столбец будет не в числовом, а в текстовом формате (добавление апострофа к значению спереди делает его строкой). Иначе у тебя будет постоянно выскакивать эта проблема: значение слишком длинное для того, чтобы Excel мог получать его, как число. Иногда получается, иногда - нет. Результат ты сам видел.
Все остальные игры (с установкой выравнивания и числового формата) можешь убрать. Если это и нужно - то оно делается не для каждого значения в отдельности, а для всего столбца целиком, после того, как данные были перенесены:
Range.Value := Data; // Перенес данные ... curr.Columns[5].HorizontalAlignment := xlRight; // И тут же их выровнял, как надо ... curr.Columns[5].VerticalAlignment := xlCenter;
То, как ты делаешь - это просто трата ресурсов...
Atreides
2.07.2011 13:19
А тогда как корректней и чтобы быстрей работало при задании формата ячеек типа NumberFormat := '##0' или NumberFormat := '##0,00'? Случается, что при вызове процедуры этой файл экселя создается и очень долго весит без дела или медленно заполняется, порой до часу может висеть, хотя из процессов в процедуре убираю процесс эеселя, с чем может быть это связанно? Судя по диспетчеру задач процесс EXCEL.EXE даже не нагружает процессор в следствии чего висит
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.