Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > БД в Delphi
Регистрация

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

Ответ
 
Опции темы
Старый 05.11.2013, 10:52   #1
Azrael2155
Пользователь
 
Регистрация: 05.11.2013
Сообщений: 13
Репутация: 10
По умолчанию Добавление на несколько листов в эксель с помощью дельфи

Допустим есть таблица

Код| Имя
1 | йцу
2 | кен
2 | фыв

Пытаюсь сделать так, что бы вывод в отчет эксель выглядел так, чтобы
На первый лист выходили только записи под кодом 1, а на второй под кодом 2.

не догоняю как это осуществить

Работаю с Delphi и SQL Server 2008

Модули AdoDataSet, AdoConnection, DataSourse

Помогите пожалуйста.

Последний раз редактировалось Azrael2155; 05.11.2013 в 10:56.
Azrael2155 вне форума   Ответить с цитированием
Старый 05.11.2013, 10:57   #2
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 23,621
Репутация: 5213
По умолчанию

а в Excel (если, допустим, всё на одну страницу) Вы каким кодом выводите?
Serge_Bliznykov вне форума   Ответить с цитированием
Старый 05.11.2013, 10:59   #3
Azrael2155
Пользователь
 
Регистрация: 05.11.2013
Сообщений: 13
Репутация: 10
По умолчанию

Вот код:
Код:


procedure TOtchet.Button5Click(Sender: TObject);
var
  XL, Sheet: Variant;
  i,s: integer;
 
  N,R: TDateTime;
  Y, M, D, Y2, M2, D2, Y3, M3, D3: Word;
 
begin
  VPR_DM.vpr_main2.Filtered:= False;
  vpr_dm.VPR_main2.Filter := 'vpr_data>='+DateToStr(DateTimePicker3. Date)+' and vpr_data<='+DateToStr(DateTimePicker4.Date);
  vpr_dm.VPR_main2.Filtered:=true;
  if MessageDlg('Действительно добавить данные в Excel?'+#13#10+
  'Подтвердите',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
 Begin
    XL := CreateOleObject('Excel.Application');
    statusbar1.Visible:=true ;
 
   try
    if XL.Workbooks.Count = 0 then begin
     XL.SheetsInNewWorkbook := 1;
     xl.workbooks.open(ExtractFilePath(ParamStr(0))+'для МДЦ (ВПР) по районам Общее за отрывок времени');
   end else
    XL.ActiveWorkbook.WorkSheets.Add;
    s:=0;
    XL.Visible := true;
 
    XL.WorkSheets[1].columns['A:A'].Select;
    XL.WorkSheets[1].Columns['A:A'].Font.Name:='Avant Greek';
    XL.WorkSheets[1].Columns['A:A'].Font.Size:=11;
    XL.WorkSheets[1].Columns['B:B'].Select;
    XL.WorkSheets[1].Columns['B:B'].Font.Name:='BankGothic Lt BT';
    XL.WorkSheets[1].Columns['B:B'].NumberFormat:='0';
 
   try
    i := 5;
    vpr_dm.Vpr_main2.First;
 
    Xl.Range[xl.Cells[i, 3], xl.Cells[vpr_dm.Vpr_main2.RecordCount+4, vpr_dm.Vpr_main2.Fields.Count]].select;
    XL.Selection.Borders.LineStyle := 7;
    xl.Selection.Borders.Weight := 2;
    XL.Range[XL.Cells[i, 3], XL.Cells[i, 3]].Select;
 
   while not vpr_dm.Vpr_main2.EOF do begin
      Sheet := xl.WorkSheets[s+1];
      Sheet.Name := 'Общий за определенный период';
 
      n:=now;
      Decodedate(n, y, m, d);
      r:=vpr_dm.Vpr_main2.FieldByName('data_r').AsDateTime;
      Decodedate(r, y2, m2, d2);
 
Sheet.Cells[1, 3].value := 'Списочный состав пациентов за:' ;
Sheet.Cells[2, 3].value := 'С '+DateToStr(DateTimePicker3. Date)+' по '+DateToStr(DateTimePicker4.Date);
Sheet.Cells[i, 3].Value := vpr_dm.spr_lpu2.FieldByName('Name').AsString;//vpr_dm.Vpr_main2.FieldByName('kod_lpu').AsString;
Sheet.Cells[i, 4].Value := vpr_dm.Vpr_main2.FieldByName('fam').AsString;
Sheet.Cells[i, 5].Value := vpr_dm.Vpr_main2.FieldByName('im').AsString;
Sheet.Cells[i, 6].Value := vpr_dm.Vpr_main2.FieldByName('ot').AsString;
Sheet.Cells[i, 7].Value := vpr_dm.spr_pol2.FieldByName('Name').AsString;
Sheet.Cells[i, 8].Value := vpr_dm.Vpr_main2.FieldByName('data_r').AsString;
Sheet.Cells[i, 9].Value := vpr_dm.Vpr_main2.FieldByName('vpr_data').AsString;
Sheet.Cells[i, 10].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_1').AsString;
Sheet.Cells[i, 11].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_2').AsString;
Sheet.Cells[i, 12].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_3').AsString;
Sheet.Cells[i, 13].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_4').AsString;
if  (y-y2)+1 > 1 then  Sheet.Cells[i, 14].Value :='Больше 1 года' else Sheet.Cells[i, 14].Value :='Меньше 1 года';
Sheet.Cells[i, 15].Value := vpr_dm.Vpr_main2.FieldByName('adrd').AsString;
Sheet.Cells[i, 16].Value := vpr_dm.Vpr_main2.FieldByName('adrd_dom').AsString;
Sheet.Cells[i, 17].Value := vpr_dm.Vpr_main2.FieldByName('adrd_korp').AsString;
Sheet.Cells[i, 18].Value := vpr_dm.Vpr_main2.FieldByName('adrd_kv').AsString;
 
    i := i + 1;
 
    vpr_dm.Vpr_main2.Next;
  end;
  finally
   XL.WorkSheets[1].Columns['A:A'].Select;
   XL.WorkSheets[1].Columns['A:A'].Rows.AutoFit;
   XL.WorkSheets[1].Columns['A:A'].Columns.AutoFit;
   XL.WorkSheets[1].Columns['B:B'].Select;
   XL.WorkSheets[1].Columns['B:B'].Rows.AutoFit;
   XL.WorkSheets[1].Columns['B:B'].Columns.AutoFit;
 
  end;
    finally
    statusbar1.Visible:=false ;
    end;
  End;
    end;


Последний раз редактировалось Stilet; 05.11.2013 в 11:01.
Azrael2155 вне форума   Ответить с цитированием
Старый 05.11.2013, 11:06   #4
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 23,621
Репутация: 5213
По умолчанию

так вот же у Вас выбор нужного листа.
Цитата:
Код:

      Sheet := xl.WorkSheets[s+1];
      Sheet.Name := 'Общий за определенный период';

вам нужно через XL.ActiveWorkbook.WorkSheets.Add добавить нужное число листов (и дать им нужные имена, если это важно).
потом переключать Sheet на нужный лист с помощью xl.WorkSheets[НомерНужногоЛиста];

вот, вкратце, и всё!
Serge_Bliznykov вне форума   Ответить с цитированием
Старый 05.11.2013, 11:09   #5
Azrael2155
Пользователь
 
Регистрация: 05.11.2013
Сообщений: 13
Репутация: 10
По умолчанию

О, спасибо, попробую.
Azrael2155 вне форума   Ответить с цитированием
Старый 05.11.2013, 11:12   #6
Stilet
Белик Виталий :)
Профессионал
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Адрес: Украина, Донецкая область, г. Краматорск
Сообщений: 57,957
Репутация: 6832
По умолчанию

Думаю что лучше так: Отсортировать по полю кода и двойным циклом вносить, потом если код меняется в следующей записи выходить из цикла, создавать новый Щит и вносить в него.
Код:

...
 
   while not vpr_dm.Vpr_main2.EOF do begin
kod:=   vpr_dm.Vpr_main2.FieldByName('Kod').AsInteger;
Sheet:=XL.ActiveWorkbook.WorkSheets.Add;
      Sheet.Name := 'Общий за определенный период ('+IntToStr(kod)+')';
while (not vpr_dm.Vpr_main2.EOF)and(vpr_dm.Vpr_main2.FieldByName('Kod').AsInteger=kod)   do begin
 
      n:=now;
      Decodedate(n, y, m, d);
      r:=vpr_dm.Vpr_main2.FieldByName('data_r').AsDateTime;
      Decodedate(r, y2, m2, d2);
 
Sheet.Cells[1, 3].value := 'Списочный состав пациентов за:' ;
Sheet.Cells[2, 3].value := 'С '+DateToStr(DateTimePicker3. Date)+' по '+DateToStr(DateTimePicker4.Date);
Sheet.Cells[i, 3].Value := vpr_dm.spr_lpu2.FieldByName('Name').AsString;//vpr_dm.Vpr_main2.FieldByName('kod_lpu').AsString;
Sheet.Cells[i, 4].Value := vpr_dm.Vpr_main2.FieldByName('fam').AsString;
Sheet.Cells[i, 5].Value := vpr_dm.Vpr_main2.FieldByName('im').AsString;
Sheet.Cells[i, 6].Value := vpr_dm.Vpr_main2.FieldByName('ot').AsString;
Sheet.Cells[i, 7].Value := vpr_dm.spr_pol2.FieldByName('Name').AsString;
Sheet.Cells[i, 8].Value := vpr_dm.Vpr_main2.FieldByName('data_r').AsString;
Sheet.Cells[i, 9].Value := vpr_dm.Vpr_main2.FieldByName('vpr_data').AsString;
Sheet.Cells[i, 10].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_1').AsString;
Sheet.Cells[i, 11].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_2').AsString;
Sheet.Cells[i, 12].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_3').AsString;
Sheet.Cells[i, 13].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_4').AsString;
if  (y-y2)+1 > 1 then  Sheet.Cells[i, 14].Value :='Больше 1 года' else Sheet.Cells[i, 14].Value :='Меньше 1 года';
Sheet.Cells[i, 15].Value := vpr_dm.Vpr_main2.FieldByName('adrd').AsString;
Sheet.Cells[i, 16].Value := vpr_dm.Vpr_main2.FieldByName('adrd_dom').AsString;
Sheet.Cells[i, 17].Value := vpr_dm.Vpr_main2.FieldByName('adrd_korp').AsString;
Sheet.Cells[i, 18].Value := vpr_dm.Vpr_main2.FieldByName('adrd_kv').AsString;
 
    i := i + 1;
 
    vpr_dm.Vpr_main2.Next;
  end;
  finally
   XL.WorkSheets[1].Columns['A:A'].Select;
   XL.WorkSheets[1].Columns['A:A'].Rows.AutoFit;
   XL.WorkSheets[1].Columns['A:A'].Columns.AutoFit;
   XL.WorkSheets[1].Columns['B:B'].Select;
   XL.WorkSheets[1].Columns['B:B'].Rows.AutoFit;
   XL.WorkSheets[1].Columns['B:B'].Columns.AutoFit;
 
  end;
    finally
    statusbar1.Visible:=false ;
    end;
  End;
    end; end;

__________________
I'm learning to live...
Stilet вне форума   Ответить с цитированием
Старый 05.11.2013, 11:44   #7
Azrael2155
Пользователь
 
Регистрация: 05.11.2013
Сообщений: 13
Репутация: 10
По умолчанию

Stilet, спасибо большое заработало, а не подскажете, так сказать юнлингу(мне), как нужно прописать, чтобы он на каждом листе с пятой строчки писал ? )


Все, сам разобрался, еще раз огромное спасибо )

Последний раз редактировалось Azrael2155; 05.11.2013 в 12:03.
Azrael2155 вне форума   Ответить с цитированием
Старый 05.11.2013, 14:48   #8
Stilet
Белик Виталий :)
Профессионал
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Адрес: Украина, Донецкая область, г. Краматорск
Сообщений: 57,957
Репутация: 6832
По умолчанию

Разобрался. это хорошо.
__________________
I'm learning to live...
Stilet вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Собрать несколько dbf в один Эксель файл. Elpis Microsoft Office Excel 47 16.01.2015 06:29
добавление и переименование листов книги kievlyanin Microsoft Office Excel 12 05.08.2009 18:14
Как выделить несколько листов сразу? frantic150 Microsoft Office Excel 3 25.06.2009 01:25
Можно ли в одной распечатке совместить несколько листов? mik Microsoft Office Excel 5 31.10.2008 07:03
Как из Дельфи связаться с открытым документом Эксель grenles Общие вопросы Delphi 4 07.07.2008 13:03


14:15.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru