Package specification:
PACKAGE Export2Excel IS
Application ole2.obj_type;
WorkBooks ole2.obj_type;
Workbook ole2.obj_type;
Worksheets ole2.obj_type;
Worksheet ole2.obj_type;
V_Border ole2.obj_type;
ExcelFont ole2.obj_type;
Cell ole2.obj_type;
Arg ole2.list_type;
ccol ole2.obj_type;
rrow ole2.obj_type;
Filename Varchar(100);
procedure OpenApplication(Filename varchar default 'New' );
Procedure OpenWorksheet(WorksheetName Varchar default 'New' );
procedure WriteIntoCell(rowno number,colno number,Fvalue varchar,typ varchar,border boolean,font boolean);
procedure MergeCells(Rstarting char,Rending char,Cstarting char,Cending char);
function ReadFromCell(rowno number,colno number,dtype Char) Return Varchar;
Procedure VisibleApps(Val Boolean);
Procedure SaveFile(Filename varchar);
Procedure ReleaseWorksheet(Filename varchar default 'New');
procedure CloseApplication;
END;
Package Body
PACKAGE BODY Export2Excel IS
Procedure OpenApplication(Filename varchar default 'New') Is
Begin
Application := ole2.create_obj('Excel.Application');
Workbooks := ole2.get_obj_property(Application,'Workbooks');
--Open Exisiting Excel File
If Filename != 'New' Then
Arg := ole2.create_arglist;
ole2.add_arg(Arg,Filename);
Workbook := ole2.get_obj_property(Workbooks,'Open',Arg);
ole2.destroy_arglist(arg);
Else
Workbook := ole2.invoke_obj(workbooks,'Add');
End If;
End OpenApplication;
Procedure OpenWorksheet(Worksheetname varchar default 'New') is
Begin
--Open Exisiting Excel Sheet
If Worksheetname != 'New' Then
Arg := ole2.create_arglist;
ole2.add_arg(Arg,Worksheetname);
WorkSheet := ole2.get_obj_property(Workbook,'WorkSheets',Arg);
ole2.destroy_arglist(arg);
Else
WorkSheets := ole2.get_obj_property(Workbook,'WorkSheets');
Worksheet := ole2.invoke_obj(Worksheets,'Add');
End If;
End OpenWorksheet;
Procedure WriteIntoCell(rowno number,colno number,Fvalue varchar,typ varchar,border boolean, Font Boolean) Is
Begin
Arg := ole2.create_arglist;
ole2.add_arg(Arg,rowno);
ole2.add_arg(Arg,colno);
Cell := ole2.get_obj_property(WorkSheet,'Cells',Arg);
ole2.destroy_arglist(arg);
If typ = 'CHAR' Then
If Substr(Fvalue,1,1) = '0' Then
ole2.Set_property(Cell,'Value',''''||Fvalue);
Else
ole2.Set_property(Cell,'Value',Fvalue);
End if;
ole2.Set_property(Cell,'NumberFormat','@');
Else
If typ = 'NUMBER' Then
ole2.Set_property(Cell,'Value',Fvalue);
ole2.Set_property(Cell,'NumberFormat','####0.00');
Else
ole2.Set_property(Cell,'Value',Fvalue);
End if;
End if;
If substr(Fvalue,3,1) in ('-','/','.') and substr(Fvalue,7,1) in ('-','/','.') Then
ole2.Set_property(Cell,'NumberFormat','d-mmm-yyyy');
End If;
If Font Then
ExcelFont := ole2.get_obj_property(Cell,'Font');
ole2.Set_property(ExcelFont,'Bold','True');
ole2.Set_property(ExcelFont,'Size',10);
ole2.release_obj(ExcelFont);
End If;
If Border Then
V_border := ole2.get_obj_property(Cell,'Borders');
ole2.Set_property(V_border,'LineStyle',1);
ole2.release_obj(V_border);
End If;
arg := ole2.create_arglist;
ole2.add_arg(arg,colno);
ccol := ole2.get_obj_property(worksheet,'Columns', arg);
ole2.destroy_arglist(arg);
ole2.invoke(ccol,'Autofit');
ole2.release_obj(cell);
End WriteIntoCell;
Procedure MergeCells (Rstarting char,Rending char,Cstarting char,Cending char) is
temp1 varchar2(20);
Begin
arg := ole2.create_arglist;
ole2.add_arg(arg,Cstarting||':'||Cending);
ccol := ole2.get_obj_property(worksheet,'Columns', arg);
ole2.destroy_arglist(arg);
arg := ole2.create_arglist;
ole2.add_arg(arg,Rstarting||':'||Rending);
rrow := ole2.get_obj_property(ccol, 'Rows', arg);
ole2.destroy_arglist(arg);
ole2.invoke(rrow, 'Merge');
Arg := ole2.create_arglist;
ole2.add_arg(Arg,Rstarting);
rrow := ole2.get_obj_property(WorkSheet,'Rows',Arg);
ole2.destroy_arglist(arg);
ole2.set_property(rrow,'RowHeight',30);
Arg := ole2.create_arglist;
ole2.add_arg(Arg,Rstarting);
ole2.add_arg(Arg,Cstarting);
Cell := ole2.Get_Obj_Property(Worksheet,'Cells',Arg);
ole2.destroy_arglist(arg);
ole2.set_property(Cell,'Wraptext','true');
ole2.set_property(Cell,'HorizontalAlignment',-4108);
ole2.set_property(Cell,'VerticalAlignment',-4108);
End;
Function ReadFromCell(rowno number,colno number,dtype char) Return Varchar is
Begin
Arg := ole2.create_arglist;
ole2.add_arg(Arg,rowno);
ole2.add_arg(Arg,colno);
Cell := ole2.get_obj_property(WorkSheet,'Cells',Arg);
If dtype = 'NUMBER' Then
Return(ole2.get_num_property(Cell,'Value'));
Elsif dtype = 'CHAR' Then
Return(ole2.get_char_property(Cell,'Value'));
Else
Return(ole2.get_char_property(Cell,'Text'));
End If;
End ReadFromCell;
Procedure VisibleApps(Val Boolean) Is
Begin
ole2.Set_property(Application,'Visible',val);
End;
Procedure SaveFile(Filename varchar) Is
Begin
Arg := ole2.create_arglist;
ole2.add_arg(Arg,Filename);
ole2.set_property(workbook,'Save',Arg);
ole2.destroy_arglist(arg);
End SaveFile;
Procedure ReleaseWorksheet(Filename varchar default 'New') Is
Begin
ole2.release_obj(Worksheet);
If Filename = 'New' Then
ole2.release_obj(WorkSheets);
End If;
end;
Procedure CloseApplication Is
Begin
ole2.release_obj(Workbook);
ole2.release_obj(Workbooks);
ole2.invoke(Application,'Quit');
ole2.release_obj(Application);
End CloseApplication;
END;
Procedure to Write new Excel sheet
PROCEDURE WRITENEW IS
BEGIN
Export2Excel.OpenApplication(
'D:\myforms\excelexport.xls'--Existing xls file name with complete path
);
Export2Excel.OpenWorksheet(
'Sheet1'--Existing worksheet name in the excel file
);
Export2Excel.WriteIntoCell(
1,--rowno
1,--colno
'character type value',--Fvalue
'CHAR',--typ
false,--border
false--Font
);
Export2Excel.WriteIntoCell(
1,--rowno
2,--colno
'character type value - with border',--Fvalue
'CHAR',--typ
true,--border
false--Font
);
Export2Excel.WriteIntoCell(
1,--rowno
3,--colno
'character type value - with border & font set',--Fvalue
'CHAR',--typ
true,--border
true--Font
);
Export2Excel.WriteIntoCell(
2,--rowno
1,--colno
'Number type value',--Fvalue
'NUMBER',--typ
false,--border
false--Font
);
Export2Excel.WriteIntoCell(
3,--rowno
1,--colno
'27-MAY-2011',--Fvalue
'DATE',--typ
false,--border
false--Font
);
Export2Excel.SaveFile(
'D:\myforms\excelexport.xls'--Existing xls file name with complete path
);
Export2Excel.ReleaseWorksheet(
'D:\myforms\excelexport.xls'--Existing xls file name with complete path
);
Export2Excel.CloseApplication;
END;
Procedure to Append contents to existing Excel sheet
PROCEDURE WRITEAPPEND IS
L_rowno NUMBER := 1;
L_colno NUMBER := 1;
BEGIN
Export2Excel.OpenApplication(
'D:\myforms\excelexport.xls'--Existing xls file name with complete path
);
Export2Excel.OpenWorksheet(
'Sheet1'--Existing worksheet name in the excel file
);
WHILE Export2Excel.ReadFromCell(L_rowno ,L_colno ,NULL) != ' '
LOOP
MESSAGE(Export2Excel.ReadFromCell(L_rowno ,L_colno ,NULL));MESSAGE('');
L_rowno := L_rowno + 1;
END LOOP;
L_rowno := L_rowno + 1;
Export2Excel.WriteIntoCell(
L_rowno,--rowno
1,--colno
'character type value',--Fvalue
'CHAR',--typ
false,--border
false--Font
);
Export2Excel.WriteIntoCell(
L_rowno,--rowno
2,--colno
'character type value - with border',--Fvalue
'CHAR',--typ
true,--border
false--Font
);
Export2Excel.WriteIntoCell(
L_rowno,--rowno
3,--colno
'character type value - with border & font set',--Fvalue
'CHAR',--typ
true,--border
true--Font
);
L_rowno := L_rowno + 1;
Export2Excel.WriteIntoCell(
L_rowno,--rowno
1,--colno
'Number type value',--Fvalue
'NUMBER',--typ
false,--border
false--Font
);
L_rowno := L_rowno + 1;
Export2Excel.WriteIntoCell(
L_rowno,--rowno
1,--colno
'27-MAY-2011',--Fvalue
'DATE',--typ
false,--border
false--Font
);
Export2Excel.SaveFile(
'D:\myforms\excelexport.xls'--Existing xls file name with complete path
);
Export2Excel.ReleaseWorksheet(
'D:\myforms\excelexport.xls'--Existing xls file name with complete path
);
Export2Excel.CloseApplication;
END;