Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на Delphi и Lazarus

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.307 RSS
←   Июнь 2011   →
 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


За последние 60 дней ни разу не выходила


Сайт рассылки: http://rusfaq.ru/
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

3.307 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на Delphi и Lazarus


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты данной рассылки

Асмик Александровна
Статус: Академик
Рейтинг: 8321
∙ повысить рейтинг » 		Орловский Дмитрий
Статус: Академик
Рейтинг: 5627
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 2669
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И СОФТ / Программирование / Delphi и Lazarus

Номер выпуска:1602
Дата выхода:22.06.2011, 22:30
Администратор рассылки:Гусятинер Леонид Борисович aka lamed (Академик)
Подписчиков / экспертов:242 / 170
Вопросов / ответов:1 / 2

Вопрос № 183651: Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос: Я работаю на Borland Delphi 7, не могу разрешить проблему с экспортом файлов в Microsoft Excel. Нужно вывести файлы из таблицы в экселевский шаблон -

Вопрос № 183651:

Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос:
Я работаю на Borland Delphi 7, не могу разрешить проблему с экспортом файлов в Microsoft Excel. Нужно вывести файлы из таблицы в экселевский шаблон -
есть код кнопки, с помощью которой и происходит действие:

var ex:olevariant;
i,j:integer;
begin

if SaveDialog1.Execute then
begin
ex:=createoleobject('excel.application');
ex.Application.EnableEvents := False;
ex.visible:=false;
Ex.DisplayAlerts:=False;
Ex.Workbooks.open(ExtractFilePath(Application.ExeName)+'Skelet2.xls');
ex.activeworkbook.activesheet.cells.item[3,4]:=Label1.Caption;
Datamodule8.Query5.First;
for i:=0 to Datamodule8.Query5.RecordCount-1 do
begin
for j:=0 to Datamodule8.Query5.FieldCount-1 do
ex.activ eworkbook.activesheet.cells.item[i+8,j+2]:=Datamodule8.Query5.Fields.Fields[j].AsString;
Datamodule8.Query5.Next;
end;
ex.activeworkbook.saveas(SaveDialog1.FileName);
ex.application.quit;
ex:=unassigned;
end;
end;

Вот изображение- результат по данному коду -

А задача заключается в том, чтобы исключить все подряд повторяющиеся значения, как в этом примере-

По возможности модифицируйте код или предложите свой вариант, спасибо за внимание.

Отправлен: 17.06.2011, 22:11
Вопрос задал: Александр (Посетитель)
Всего ответов: 2
Страница вопроса »

Отвечает Тимошенко Дмитрий (Практикант) :
Здравствуйте, Александр!

Попробуйте такой вариант:
Код :
var ex:olevariant;
i,j:integer;
begin
  if SaveDialog1.Execute then
  begin
    ex:=createoleobject('excel.application');
    ex.Application.EnableEvents := False;
    ex.visible:=false;
    Ex.DisplayAlerts:=False;
    Ex.Workbooks.open(ExtractFilePath(Application.ExeName)+'Skelet2.xls');
    ex.activeworkbook.activesheet.cells.item[3,4]:=Label1.Caption;
    Datamodule8.Query5.First;
    for i:=0 to Datamodule8.Query5.RecordCount-1 do
    begin
      for j:=0 to Datamodule8.Query5.FieldCount-1 do
      {*** Добавил здесь ***}
      begin
        if ex.activeworkbook.activesheet.cells.item[i+7,j+2]=Datamodule8.Query5.Fields.Fields[j].AsString then {Первый повтор }
          ex.activeworkbook.activesheet.cells.item[i+8,j+2]:='!'+Datamodule8.Query5.Fields.Fields[j].AsString;
        else if ex.activeworkbook.activesheet.cells.item[i+7,j+2]='!'+Datamodule8.Query5.Fields.Fields[j].AsString then begin { n-й повтор }
          ex.activeworkbook.activesheet.cells.item[i+7,j+2]:='';
          ex.activeworkbook.activesheet.cells.item[i+8,j+2]:='!'+Datamodule8.Query5.Fields.Fields[j].AsString;
        end else { новое значение }
        begin
          if copy(ex.activeworkbook.activesheet.cells.item[i+7,j+2],1,1)='!' then ex.activeworkbook.activesheet.cells.item[i+7,j+2]='';
          ex.activeworkbook.activesheet.cells.item[i+8,j+2]:=Datamodule8.Query5.Fields.Fields[j].AsString;
        end;
      end;
      {*** Конец ***}
      Datamodule8.Query5.Next;
    end;
    ex.activeworkbook.saveas(SaveDialog1.FileName);
    ex.application.quit;
    ex:=unassigned;
  end;
end;


Добавил код внутрь вашего цикла. (Выделен комментариями). Смысл его в том, что при выводе текущей ячейки мы ее сначала сравниваем с предыдущей, при совпадении добавляем к значению спец.знак ('!' - для того чтобы распознать несколько совпадений идущих подряд), а при разных значениях просто заносим новое значение в ячейку. Вопросы в минифорум.

С уважением, Дмитрий

Ответ отправил: Тимошенко Дмитрий (Практикант)
Ответ отправлен: 20.06.2011, 04:17
Номер ответа: 267783
Россия, Брянская обл.

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 267783 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Отвечает Гусятинер Леонид Борисович aka lamed (Академик) :
    Здравствуйте, Александр!
    Вам требуется получить отчет с группировкой. Уровень - 2. Внешний уровень - по фамилии, внутренний - по дисциплине. Вводятся две дополнительные переменные, инициализируются значением, которое заведомо не встретится в строках результата запроса.
    Код :
    var ex:olevariant;
 i,j:integer;
 cName, cDiscipline: string;
begin

 if SaveDialog1.Execute then
 begin
   ex:=createoleobject('excel.application');
   ex.Application.EnableEvents := False; 
   ex.visible:=false;
   Ex.DisplayAlerts:=False;
   Ex.Workbooks.open(ExtractFilePath(Application.ExeName)+'Skelet2.xls');
   ex.activeworkbook.activesheet.cells.item[3,4]:=Label1.Caption;
   
   cName := '$';
   cDiscipline := '$';
   
   Datamodule8.Query5.First;
   for i:=0 to Datamodule8.Query5.RecordCount-1 do
   begin
     if Datamodule8.Query5.Fields.Fields[0].AsString = cName then
       begin
         ex.activeworkbook.activesheet.cells.item[i+8,2]:= ' ';
         if Datamodule8.Query5.Fields.Fields[1].AsString = cDiscipline then
           ex.activeworkbook.activesheet.cells.item[i+8,2]:=' '
         else
           begin
             cDiscipline := Datamodule8.Query5.Fields.Fields[1].AsString;
             ex.activeworkbook.activesheet.cells.item[i+8,3]:= cDiscipline;
           end
       end
     else
       begin
         cDiscipline := Datamodule8.Query5.Fields.Fields[1].AsString;
         ex.activeworkbook.activesheet.cells.item[i+8,3]:= cDiscipline;
       endl
     for j:=2 to Datamodule8.Query5.FieldCount-1 do
       ex.activeworkbook.activesheet.cells.item[i+8,j+2]:=Datamodule8.Query5.Fields.Fields[j].AsString;
     Datamodule8.Query5.Next;
   end;
   ex.activeworkbook.saveas(SaveDialog1.FileName);
   ex.application.quit;
   ex:=unassigned;
 end;
end;

    Поскольку полного проекта нет, требуется Ваша проверка.
    Удачи!

    Ответ отправил: Гусятинер Леонид Борисович aka lamed (Академик)
    Ответ отправлен: 20.06.2011, 08:09
    Номер ответа: 267784
    Россия, Ковров
    Тел.: +79107793141

    Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
    Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 267784 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2011, Портал RFPRO.RU, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Калашников О.А. | Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2011.6.31 от 07.05.2011
    В избранное