CftClub.ru
Клуб специалистов ЦФТ-Банк 		   О проекте, Правила Клуба, FAQО проекте   Поиск по материалам КлубаПоиск    Отзывы Участников и посетителейОтзывы    Стать Участником КлубаРегистрация    ВходВход

Загрузка в EXCEL (пакет RUNTIME.EXCEL)

 
Ответить на тему    Клуб специалистов ЦФТ-Банк (IBSO) -> Мастер-класс от Участников Клуба
Предыдущая тема :: Следующая тема  
Автор Сообщение
ALEX_DV
Участник


Вступление в Клуб: 26.02.2010
СообщениеСр Фев 16, 2011 08:15   Загрузка в EXCEL (пакет RUNTIME.EXCEL) Ответить с цитатой
Полезность: 2
Вступление.
БОльшая часть отчетов в "нашем" IBSO реализуется операциями вывода данных в EXCEL. Reports забыт как страшный сон. Пусть индусы сами им пользуются. Чтобы сделать качественное форматирование, нужно либо не ценить своё время, либо быть мазохистом. (+отсутствие редактирования)
IBSO "наше" Smile, т.к. от оригинальной системы только ядро. Весь функционал самодельный. Это я к тому, что часть информации, которой я хочу поделиться может быть уже реализована в оригинальной системе. Если это так - хорошо, а иначе надеюсь кому-нибудь будет полезной. Каким образом в системе, находящейся на поддержке, перенести это в боевую версию я понятия не имею.

Весь код имеет отношение к библиотеке RUNTIME.EXCEL

Отладка. Трудная штука. Облегчим.
Глобальные описания:
Код:
--Режим отладки (true). Включайте после INIT_XLS и не забывайте отключать!!!(в режиме отладки очень большой скрипт)
XL_DEBUG  boolean := false;

Локальные описания:
Добавляем в начало процедуры Add_Row код:
Код:
if XL_DEBUG then
 ds :=  'On Error Resume Next'||NL$||
 'Err.Clear'||NL$||ds||NL$||
 'If Err <> 0 Then'||NL$||
 ' Msg = "Возникла ошибка # " & Err.Number & vbCrLf & Err.Description & vbCrLf & " '||Replace(Replace(Replace(ds, '"', '""'), chr(10), '"&chr(10)&"'), chr(13), '"&chr(13)&"') ||' "'||NL$||
 ' MsgBox Msg, , "Error" '||NL$||
 'End if'||NL$;
end if;

Добавляем в процедуру Init_XLS код:
Код:
XL_DEBUG := False;

Временами очень помогает.

Функции:
Код:

--Заменить в ячейках текущего листа текст What на текст Replacement (без учета регистра)
procedure Replace_(What varchar2(2000), Replacement varchar2(2000));
procedure Replace_(What varchar2(2000), Replacement varchar2(2000)) is
begin
 ds := 'xls.Application.DisplayAlerts=false'||NL$||'res=Sheet.Cells.Replace("'||Replace(Replace(Replace(What, '"', '""'), chr(10), '"&chr(10)&"'), chr(13), '"&chr(13)&"')||'", '||
  '"'||Replace(Replace(Replace(Replacement, '"', '""'), chr(10), '"&chr(10)&"'), chr(13), '"&chr(13)&"')  ||'")'||NL$||
  'xls.Application.DisplayAlerts=true';
 Add_Row;
end;

--Добавить комментарий к ячейке
procedure Add_Comment(iRow0 integer, iCol0 integer, text_comment  varchar2);
procedure Add_Comment
     ( iRow0   integer
     , iCol0   integer
     , text_comment  varchar2
     ) is
begin
 ds := 'Call Sheet.Range('||get_range(iCol0, iRow0, iCol0, iRow0)||').AddComment("'||Replace(Replace(Replace(text_comment, '"', '""'), chr(10), '"&chr(10)&"'), chr(13), '"&chr(13)&"') ||'") ';
 Add_Row;
end;

-- ориентация текста в ячейке(диапазоне) Orientation - угол -90....90
-- -90 -снизу вверх, 0 - норма, 90 - сверху вниз
procedure Set_Orientation_Text(iRow0 integer, iCol0 integer, iRow integer, iCol integer, Orientation pls_integer default 90);
procedure Set_Orientation_Text(iRow0 integer, iCol0 integer, iRow integer, iCol integer, Orientation pls_integer default 90) is
begin
 ds := 'Sheet.Range('||get_range(iCol0, iRow0, iCol, iRow)||').Orientation = '||Orientation;
 Add_Row;
end;

--Отступ текста в ячейке на vLevel in (0..15)
procedure Set_Indent( iRow integer, iColumn integer, vLevel integer);
procedure Set_Indent( iRow integer, iColumn integer, vLevel integer) is
begin
 ds := 'Sheet.Range("'|| vCol(iColumn) || iRow ||'").IndentLevel = '||vLevel;
 Add_Row;
end;

--Группировать строки
procedure Group_Rows( iRow0 integer, iRow integer,on_error boolean default false);
procedure Group_Rows( iRow0 integer,iRow integer,on_error boolean default false) is
begin
 if on_error then
  ds := 'On Error Resume Next'||NL$||'Err.Clear'||NL$;
 end if;
 ds := ds||'Sheet.Rows("'|| iRow0 ||':'|| iRow ||'").Rows.Group';
 Add_Row;
end;

procedure Go_Cell(iRow  integer, iCol  integer);
procedure Go_Cell(iRow  integer, iCol  integer) is
begin
 ds := 'Sheet.Range("'|| vCol(iCol) || iRow ||'").Select';
 Add_Row;
end;

--Установить ориентацию и границы ("отступы" для печати) для
--   1. Текущего активного листа -> num_sh=0
--   2. Листa № <num_sh>
--   4. Всех листов книги  -> num_sh = null
--Ориентация
--   Portrait = 1 - книжная
--   Landscape = 2 - альбомная
--Границы
--    ...Margin - с сантиметрах(напр. 0.1)
--Вывод сквозных строк(стрки), кот. печатаются на каждой странице
--    PrintTitleRowStart : PrintTitleRowEnd (укажите оба параметра)
procedure PageSetup(Orientation number default Portrait,
           num_sh number default null,
           LeftMargin number default null,
           RightMargin number default null,
           TopMargin  number default null,
           BottomMargin number default null,
           PrintTitleRowStart number default null,
           PrintTitleRowEnd number default null);
procedure PageSetup(Orientation number default Portrait,
           num_sh number default null,
           LeftMargin number default null,
           RightMargin number default null,
           TopMargin  number default null,
           BottomMargin number default null,
           PrintTitleRowStart number default null,
           PrintTitleRowEnd number default null
           ) is
begin
 if (PrintTitleRowStart + PrintTitleRowEnd) is null then
  PrintTitleRowStart:=null; PrintTitleRowEnd:=null;
 end if;
 if num_sh = 0 then--только для текущего активного листа
  ds:='Set Sh = Sheet';
 elsif num_sh is not null then--только для листа с номером <num_sh>
  ds:='Set Sh = book.Worksheets('||num_sh||')';
 else--для всех листов книги
  ds:='Set Sh = Nothing';
 end if;
 ds := ds||NL$||
    'For S = 1 To book.Sheets.count'||NL$||
     'Set CurSh = book.Worksheets(S)'||NL$||
     'if Sh is Nothing or CurSh is Sh then'||NL$||
          'CurSh.PageSetup.Orientation = '|| Orientation||NL$||
          bool_char(LeftMargin is not null,  'CurSh.PageSetup.LeftMargin = CurSh.Application.CentimetersToPoints('|| LeftMargin ||')'||NL$, '')  ||
      bool_char(RightMargin is not null, 'CurSh.PageSetup.RightMargin = CurSh.Application.CentimetersToPoints('|| RightMargin ||')'||NL$, '')  ||
      bool_char(TopMargin is not null, 'CurSh.PageSetup.TopMargin = CurSh.Application.CentimetersToPoints('|| TopMargin ||')'||NL$, '')  ||
      bool_char(BottomMargin is not null, 'CurSh.PageSetup.BottomMargin = CurSh.Application.CentimetersToPoints('|| BottomMargin||')'||NL$, '')  ||
      bool_char((PrintTitleRowStart+PrintTitleRowEnd) is not null, 'CurSh.PageSetup.PrintTitleRows = "$'|| PrintTitleRowStart || ':$'|| PrintTitleRowEnd ||'"'||NL$, '')  ||
         'end if'||NL$||
       'Next';
 Add_Row;
end;

--Автоподбор высоты строки по содержимому
--Не работает с объединёнными ячейками (merge)! (проблемы EXCEL)
procedure Auto_height ( iRow0 integer,iCol0 integer,iRow integer,iCol integer);
procedure Auto_height ( iRow0 integer,iCol0 integer,iRow integer,iCol integer) is
range varchar2(10);
begin
 range := get_range(iRow0, iCol0, iRow, iCol);
 ds  := 'Sheet.Range('||range||').Rows.AutoFit';
 Add_Row;
end;

-- поменять имя документу EXCEL
procedure change_ExcelCaption( new_caption in varchar2 );
procedure change_ExcelCaption( new_caption in varchar2 ) is
begin --Aplication.Caption = "test"   Заменит Microsoft Excel на test
 ds := 'xls.ActiveWorkbook.Windows(1).Caption = "'||Replace(Replace(Replace(new_caption, '"', '""'), chr(10), '"&chr(10)&"'), chr(13), '"&chr(13)&"')||'"';
 Add_Row;
end;

--Закрепить области (меню "Окно"->"Закрепить области")
procedure FreezePanes(iRow integer,iCol integer);
procedure FreezePanes( iRow integer,iCol  integer) is
begin
 ds := 'Sheet.Range("'|| vCol(iCol) || iRow ||'").Select'||NL$||
    'xls.ActiveWorkbook.Windows(1).FreezePanes=True';
 Add_Row;
end;

--Включить авто-фильтр на диапазоне
procedure Auto_Filter(iRow0 integer, iCol0 integer, iRow integer, iCol integer);
procedure Auto_Filter(iRow0 integer, iCol0 integer, iRow integer, iCol integer) is
begin
 ds := 'Sheet.Range('||get_range(iCol0, iRow0, iCol, iRow)||').AutoFilter';
 Add_Row;
end;

--Защита файла от редактирования с помощью установки пароля
procedure Protect( p_password varchar2 );
procedure Protect( p_password varchar2 ) is
begin
 p_password := replace(replace(p_password, chr(13), '" & Chr(13) & "' ), chr(10), '" & Chr(10) & "' );
 ds := 'For S = 1 To book.Sheets.count'||NL$||
           'Set sh = book.Worksheets(S)'||NL$||
           'call sh.Protect("'||p_password||'")'||NL$||
    'Next'||NL$||
    'If book.ProtectStructure = False Then'||NL$||
     'call book.Protect("'||p_password||'")'||NL$||
    'End If';
 Add_Row;
end;

--Скрыть(false) / показать(true) сетку на листе
procedure DisplayGrid( show boolean default false);
procedure DisplayGrid( show boolean default false) is
begin
 ds := 'xls.ActiveWorkbook.Windows(1).DisplayGridlines='||bool_char(show, 'True', 'False');
 Add_Row;
end;

--автоподбор размера шрифта в соответствии с шириной ячейки,
--чтоб в ячейке не было символов "##########" из-за того, что значение не умещается в ячейку
procedure ShrinkToFit( iRow0 integer, iCol0 integer, iRow integer, iCol integer, ShrinkToFit boolean default true);
procedure ShrinkToFit( iRow0 integer, iCol0 integer, iRow integer, iCol integer, ShrinkToFit boolean default true) is
begin
 ds := 'Sheet.Range('||get_range(iCol0, iRow0, iCol, iRow)||').ShrinkToFit = ';
 if nvl(ShrinkToFit,false)
  then ds := ds || 'true';
  else ds := ds || 'false';
 end if;
 Add_Row;
end;

--Записать данные в строку row, начиная с колонки col
--value1..value10 - значения
--если есть merge ячейки, то записываем в ближайшую слева колонку
--(вызывает Write_Row_Ex)
procedure Write_Row(row number,
           col  number,
           value1 varchar2(2000) default null,
           value2 varchar2(2000) default null,
           value3 varchar2(2000) default null,
           value4 varchar2(2000) default null,
           value5 varchar2(2000) default null,
           value6 varchar2(2000) default null,
           value7 varchar2(2000) default null,
           value8 varchar2(2000) default null,
           value9 varchar2(2000) default null,
           value10 varchar2(2000) default null);
procedure Write_Row(row  number,
           col  number,
           value1 varchar2(2000) default null,
           value2 varchar2(2000) default null,
           value3 varchar2(2000) default null,
           value4 varchar2(2000) default null,
           value5 varchar2(2000) default null,
           value6 varchar2(2000) default null,
           value7 varchar2(2000) default null,
           value8 varchar2(2000) default null,
           value9 varchar2(2000) default null,
           value10 varchar2(2000) default null) is
data tbl_str;
begin
 if value10 is not null then data(col+9):=value10; end if;
 if value9 is not null then data(col+Cool:=value9; end if;
 if value8 is not null then data(col+7):=value8; end if;
 if value7 is not null then data(col+6):=value7; end if;
 if value6 is not null then data(col+5):=value6; end if;
 if value5 is not null then data(col+4):=value5; end if;
 if value4 is not null then data(col+3):=value4; end if;
 if value3 is not null then data(col+2):=value3; end if;
 if value2 is not null then data(col+1):=value2; end if;
 if value1 is not null then data(col):=value1; end if;
 Write_Row_Ex(row, data);
end;


--Записать данные в строку row
--data - pl/sql таблица данных
--индекс в таблице = номеру колонки, в которую необходимо записать значение
--можно заполнять data с разрывами
procedure Write_Row_Ex(row number, data tbl_str);
procedure Write_Row_Ex(row  number, data tbl_str) is
arr_value varchar2(32000);
first_ind  pls_integer;
begin
 first_ind := data.first;
 if first_ind is null then return; end if;
 for i in first_ind..data.last loop
  if data.exists(i) then
   arr_value := arr_value||'"'||Replace(Replace(Replace(data(i), '"', '""'), chr(10), '"&chr(10)&"'), chr(13), '"&chr(13)&"')||'",';
  else
   arr_value := arr_value||'"",';
  end if;
 end loop;
 arr_value := rtrim(arr_value,',');
 ds := 'Sheet.Range('||get_range(first_ind, row, data.last, row)||')=Array('||arr_value||')';
 Add_Row;
end;


Хочется уделить особое внимание последним двум функциям Write_Row и Write_Row_Ex.
Всё остальное – лирика.

Сама технология загрузки в EXCEL достаточно тормозная. Иногда это очень раздражает ) На протяжении многих лет борьбы с этим недоразумением голову посещали разные идеи, часть из которых была воплощена в жизнь, а часть так осталась в голове. Но это отдельная тема.
В рамках существующего механизма функция Write_Row позволяет увеличить скорость загрузки для некоторых наборов данных в РАЗЫ!. Основой служит присвоение масива данных диапазону - Sheet.Range()=Array(). Можете потестить в редакторе макросов excel’я. Закрутите цикл на большое кол-во строк и сравните Sheet.Range(…)=Array(…) и Sheet.Cells(r, c) = …
Классика
Код:
--цикл по pl/sql табличке
ind_s:=CLTS.first;
while ind_s is not null loop
  EXCEL.Write(iRow, 1, CLTS(ind_s).NAME);
  EXCEL.Write(iRow, 2, CLTS(ind_s).INN);
  EXCEL.Write(iRow, 3, GatAccInfo(CLT_REF);
  EXCEL.Write(iRow, 4, CLTS(ind_s).MB);
  EXCEL.Write(iRow, 5, CLTS(ind_s).MF);
  EXCEL.Write(iRow, 6, CLTS(ind_s).VN);
  iRow:=iRow+1;
  ind_s:=CLTS.next(ind_s);
end loop;

Так веселей
Код:
--цикл по pl/sql табличке
ind_s:=CLTS.first;
while ind_s is not null loop
  EXCEL.Write_Row(iRow, 1, CLTS(ind_s).NAME, CLTS(ind_s).INN,
  GatAccInfo(CLT_REF), CLTS(ind_s).MB, CLTS(ind_s).MF, CLTS(ind_s).VN);
  iRow:=iRow+1;
  ind_s:=CLTS.next(ind_s);
end loop;

Важно. Write_Row не работает с формулами. EXCEL.Write_Row(iRow, 1, ‘=SUMM(R[-2]C:R[-1]C’); не работает


P.S. Уважаемые коллеги, кого-нибудь достает warning, вылетающий при загрузке данных в EXCEL (WORD) - "Сервер занят" ("Повторить", "Переключиться")?
Показать сообщения:   
Ответить на тему    Клуб специалистов ЦФТ-Банк (IBSO) -> Мастер-класс от Участников Клуба Часовой пояс: GMT + 3
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах
Домен cftclub.ru не связан с ЗАО "Центр Финансовых Технологий" и ни в коей мере не нарушает авторских и иных прав
Владелец может не разделять мнения Участников и не несет ответственности за их публикации
Powered by phpBB