تصدير البيانات من الفورم للإكسل

PACKAGE BODY l_pkg_gen_xl IS
-------------------------------------------------------------------------
Procedure put_cell (Row_num number,
Col_num number,
put_value varchar2,
font_name varchar2 default null,
font_size binary_integer default null,
font_style varchar2 default null,/*here you can pass BOLD for bold, ITALIC for italic etc*/
font_color binary_integer default null) is
Begin
Arglist := OLE2.create_arglist;
OLE2.add_arg(Arglist,row_num);
OLE2.add_arg(Arglist,col_num);
cell := OLE2.get_obj_property(Worksheet,'Cells',Arglist);
OLE2.destroy_arglist(Arglist);
OLE2.set_property(cell,'Value',put_value);
Workfont := OLE2.get_obj_property(cell,'Font');
WorkInterior := OLE2.get_obj_property(cell,'Interior');
If font_name is not null then
OLE2.set_property(Workfont,'Name',font_name);
End if;
If font_size is not null then
OLE2.set_property(Workfont,'Size',font_size);
End if;
If font_style is not null then
OLE2.set_property(Workfont,font_style,1);
End if;
If font_color is not null then
OLE2.set_property(Workfont,'ColorIndex',font_color);
End if;
OLE2.release_obj(workfont);
OLE2.release_obj(workinterior);
OLE2.release_obj(cell);
End;
-------------------------------------------------------------------------
Procedure init is
BEGIN
APPLICATION := OLE2.CREATE_OBJ('Excel.Application');
OLE2.SET_PROPERTY(APPLICATION,'Visible',True);
WORKBOOKS := OLE2.GET_OBJ_PROPERTY(APPLICATION, 'WORKBOOKS');
WORKBOOK := OLE2.INVOKE_OBJ(WORKBOOKS, 'ADD');
WORKSHEETS := OLE2.GET_OBJ_PROPERTY(WORKBOOK, 'WORKSHEETS');
WORKSHEET := OLE2.INVOKE_OBJ(WORKSHEETS, 'ADD');
OLE2.set_property(Worksheet,'Name','My sheet');
End;
-------------------------------------------------------------------------
PROCEDURE l_print_block(p_block varchar2,p_multi_record_yn varchar2,p_print_header_yn varchar2,p_print_append_yn varchar2 ) is
Begin
GO_BLOCK(p_block);
If p_multi_record_yn = 'Y' then
FIRST_RECORD;
end if;
/*as your data should print from second/first row based on p_print_header_yn row*/
If p_print_append_yn = 'N' then --initilize j to print from the first row if append is N,else print starts from second row
If p_print_header_yn = 'Y' then
h:=2; --row count
j:= 2;
else
j := 1;
end if;
else--append to the row
If p_print_header_yn = 'Y' then
h:=j+1; --row count
j:=j+1;
end if;
end if;
K:=1;
LOOP
m_item := get_block_property(p_block,first_item);
K:=1; --column count
Loop
exit when M_ITEM IS NULL ;
If not id_null(find_item(p_block||'.'||m_item)) then
If get_item_property(p_block||'.'||m_item,item_type)IN ( 'TEXT ITEM' ,'DISPLAY ITEM','LIST','CHECKBOX')
/* and get_item_property(p_block||'.'||m_item,visible) ='TRUE' */ then
If (j=h) and p_print_header_yn = 'Y' then --prints the heading
put_cell(j-1,k,get_item_property(p_block||'.'||m_item,ITEM_NAME ));--prints the ITEM_NAME
end if;
If not name_in(p_block||'.'||m_item) is NULL Then ---prints value
put_cell(j,k,name_in(p_block||'.'||m_item));
End If;
K:=k+1;
end if;
end if;
m_item := get_item_property(p_block||'.'||m_item,NEXTITEM );
END LOOP;
J:=J+1;
exit when :system.last_record = 'TRUE';
If p_multi_record_yn = 'Y' then
NEXT_RECORD;
else
exit;
end if;
END LOOP;
END;
-------------------------------------------------------------------------
Procedure save_xl(p_path varchar2,p_excel_name varchar2) is
Begin
OLE2.Release_Obj(worksheet);
OLE2.Release_Obj(worksheets);
-- Save the Excel file created
If p_path is not null then
Arglist := OLE2.Create_Arglist;
OLE2.Add_Arg(Arglist,p_path||'\'||p_excel_name||'.xls');
OLE2.Invoke(workbook, 'SaveAs', Arglist);
OLE2.Destroy_Arglist(Arglist);
end if;
End;
-------------------------------------------------------------------------
Procedure release_xl is
Begin
-- release workbook
OLE2.Release_Obj(workbook);
OLE2.Release_Obj(workbooks);
OLE2.Release_Obj(application);
End;
-------------------------------------------------------------------------
END;
بعدها في اي مكان على الفورم وليكن زر مثلا اكتب الكود الآتى


كود:
Begin
l_pkg_gen_xl.init; /*initilizes the excel objects*/
/*l_print_block(p_block varchar2,p_multi_record_yn varchar2,p_print_header_yn varchar2,p_print_append_yn varchar2 );*/
l_pkg_gen_xl.l_print_block(:system.current_block ,'Y','Y','N' ); /*Prints My header block,single record block,header should be pritned,as it is first block append is N*/
--l_pkg_gen_xl.l_print_block('JPA_BUDG_DET','Y','Y','Y' );/*Prints My detail block,multi record,header should be printed,it is second block and it should be appended with previous data*/
l_pkg_gen_xl.save_xl('C:\temp','myexcel');/*Save excel in the given path in the given name*/
l_pkg_gen_xl.release_xl; /*release all objects*/
End;