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

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 услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.



    В избранное