Script to convert Report to Excel

REM: Script to convert Report to Excel
REM:
REM: Author: Shadab Ali
REM: Date Submitted: 07-Jan-2006
REM: Date Posted: 08-Jan-2006
REM:
REM:*****************************************
REM: NOTE: PLEASE TEST THIS SCRIPT BEFORE USE.
REM: Author will not be responsible for any damage that may be cause by this script.
REM:*****************************************

*************-*********************
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 move2Line(line in NUMBER);
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 move2Line(line in NUMBER) IS
BEGIN
CurrentRow:=CurrentRow+line;
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;
/