paparao03

 Profile Answers by paparao03 

• Nov 3rd, 2006

 

check the following procedure

PACKAGE RPT2XLS IS
 -- Font style constants
 BOLD constant binary_integer := 1;
 ITALIC constant binary_integer := 2;
 UNDERLINE constant binary_integer := 4;

 -- Horizontal alignment constants
 SUBTYPE xlHAlign IS binary_integer;
 CENTER        CONSTANT xlHAlign := -4108;
 CENTERACROSSSELECTION CONSTANT xlHAlign := 7;
 DISTRIBUTED      CONSTANT xlHAlign := -4117;
 FILL         CONSTANT xlHAlign := 5;
 GENERAL        CONSTANT xlHAlign := 1;
 JUSTIFY        CONSTANT xlHAlign := -4130;
 LEFT         CONSTANT xlHAlign := -4131;
 RIGHT         CONSTANT xlHAlign := -4152;

 PROCEDURE put_cell(ColNo binary_integer, CellValue in varchar2,
           FontName in varchar2 DEFAULT null,
           FontSize in binary_integer DEFAULT null,
           FontStyle in binary_integer DEFAULT null,
           FontColor in binary_integer DEFAULT null,
           BgrColor in binary_integer DEFAULT null,
           Format in varchar2 DEFAULT null,
           Align in xlHAlign DEFAULT null
           );
 PROCEDURE new_line;
 PROCEDURE run;
 PROCEDURE release_memory;

END;

PACKAGE BODY RPT2XLS IS

 TYPE ExcelCell IS RECORD(RowNo binary_integer,
              ColNo binary_integer,
              Val varchar2(2000),
              FontName varchar2(20),
              FontSize binary_integer,
              FontStyle binary_integer,
              FontColor binary_integer,
              BgrColor binary_integer,
               Format varchar2(60),
              Align xlHAlign
              );
 TYPE ExcelCells IS TABLE OF ExcelCell;
 Cell ExcelCells := ExcelCells();

 CurrentRow binary_integer := 1;

 PROCEDURE new_line IS
 BEGIN
  CurrentRow := CurrentRow + 1;
 END;
 

 PROCEDURE put_cell(ColNo binary_integer, CellValue in varchar2,
           FontName in varchar2 DEFAULT null,
           FontSize in binary_integer DEFAULT null,
           FontStyle in binary_integer DEFAULT null,
           FontColor in binary_integer DEFAULT null,
           BgrColor in binary_integer DEFAULT null,
           Format in varchar2 DEFAULT null,
           Align in xlHAlign DEFAULT null
           ) IS
 BEGIN
  Cell.Extend;
  Cell(Cell.Last).RowNo := CurrentRow;
  Cell(Cell.Last).ColNo := ColNo;
  Cell(Cell.Last).Val := CellValue;
  Cell(Cell.Last).FontName := FontName;
  Cell(Cell.Last).FontSize := FontSize;
  Cell(Cell.Last).FontStyle := FontStyle;
  Cell(Cell.Last).FontColor := FontColor;
  Cell(Cell.Last).BgrColor := BgrColor;
  Cell(Cell.Last).Format := Format;
  Cell(Cell.Last).Align := Align;
 END;

 PROCEDURE run IS
  Application OLE2.OBJ_TYPE;
  Workbooks OLE2.OBJ_TYPE;
  Workbook OLE2.OBJ_TYPE;
  Worksheets OLE2.OBJ_TYPE;
  Worksheet OLE2.OBJ_TYPE;
  WorkCell OLE2.OBJ_TYPE;
  WorkColumn OLE2.OBJ_TYPE;
    WorkFont OLE2.OBJ_TYPE;
    WorkInterior OLE2.OBJ_TYPE;
  ArgList OLE2.LIST_TYPE;
 BEGIN

  Application := OLE2.create_obj('Excel.Application');
  OLE2.set_property(Application, 'Visible', 1);
  Workbooks := OLE2.get_obj_property(Application, 'Workbooks');
    Workbook := OLE2.invoke_obj(WorkBooks, 'Add');
  Worksheets := OLE2.get_obj_property(Workbook, 'Worksheets');
  Worksheet := OLE2.get_obj_property(Application, 'ActiveSheet');

  for i in Cell.First .. Cell.Last
  loop
   if Cell(i).Val is not null then
    ArgList := OLE2.create_arglist;
    OLE2.add_arg(ArgList, Cell(i).RowNo);
    ole2.add_arg(ArgList, Cell(i).ColNo);
    WorkCell := OLE2.get_obj_property(Worksheet, 'Cells', ArgList);
    ole2.destroy_arglist(ArgList);
    ole2.set_property(WorkCell, 'Value', Cell(i).Val);
    ole2.set_property(WorkCell, 'NumberFormat', Cell(i).Format);

    if Cell(i).Align is not null then
     ole2.set_property(WorkCell, 'HorizontalAlignment', Cell(i).Align);
    end if;

    WorkFont := OLE2.get_obj_property(WorkCell, 'Font');
    WorkInterior := ole2.Get_Obj_Property(WorkCell, 'Interior');

    if Cell(i).FontName is not null then
     OLE2.set_property(WorkFont, 'Name', Cell(i).FontName);
    end if;
    if Cell(i).FontSize is not null then
     OLE2.set_property(WorkFont, 'Size', Cell(i).FontSize);
    end if;
    if mod(Cell(i).FontStyle, 2) = 1  then
     OLE2.set_property(WorkFont, 'Bold', 1);
    end if;
    if mod(Cell(i).FontStyle, 4) > 2  then
     OLE2.set_property(WorkFont, 'Italic', 1);
    end if;
    if mod(Cell(i).FontStyle, 8) > 4  then
     OLE2.set_property(WorkFont, 'Underline', 2);
    end if;
    if Cell(i).FontColor is not null then
     OLE2.set_property(WorkFont, 'ColorIndex', Cell(i).FontColor);
    end if;
    if Cell(i).BgrColor is not null then
     OLE2.set_property(WorkInterior, 'ColorIndex', Cell(i).BgrColor);
    end if;

    OLE2.release_obj(WorkInterior);
    OLE2.release_obj(WorkFont);
    OLE2.release_obj(WorkCell);
   end if;
  end loop;

  ArgList := ole2.create_arglist;
  ole2.add_arg(ArgList, 'A:Z');
  WorkColumn := ole2.Get_Obj_Property(WorkSheet, 'Columns', ArgList);
  ole2.destroy_arglist(ArgList);
  ole2.invoke(WorkColumn, 'AutoFit');

  OLE2.release_obj(WorkColumn);
  OLE2.release_obj(Worksheet);
  OLE2.release_obj(Worksheets);
  OLE2.release_obj(Workbook);
  OLE2.release_obj(Workbooks);
  OLE2.release_obj(Application);

 END;

 PROCEDURE release_memory IS
 BEGIN
  Cell := ExcelCells();
  SYS.DBMS_SESSION.free_unused_user_memory;
 END;

END;