Wednesday, May 29, 2013

Export Oracle Form To Excel (Program Unit)


Ada kalanya kita membutuhkan data dari oracle untuk kita olah lagi dalam bentuk excel, oleh karena itu kita butuh program unutk meng export data tersebut. Langsung saja tulis /copas coding berikut.

Buat Program Unit :
1. Package Spec
PACKAGE l_pkg_gen_xl IS

APPLICATION OLE2.OBJ_TYPE;
WORKBOOKS OLE2.OBJ_TYPE;
WORKBOOK OLE2.OBJ_TYPE;
WORKSHEETS OLE2.OBJ_TYPE;
WORKSHEET OLE2.OBJ_TYPE;
Arglist OLE2.LIST_TYPE;
CELL OLE2.OBJ_TYPE;
Workfont OLE2.OBJ_TYPE;
WorkInterior OLE2.OBJ_TYPE;
J INTEGER;--row count
K INTEGER; --column count
h integer;--row number for heading
m_item varchar2(40);

 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);

 Procedure l_print_block(p_block varchar2,p_multi_record_yn varchar2,p_print_header_yn varchar2,p_print_append_yn varchar2 );
                 
 Procedure init;
Procedure save_xl(p_path varchar2,p_excel_name varchar2);
Procedure release_xl;
                   
END;

2. L_PKG_GEN_XL (Package Body)

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,prompt_text));--prints the  prompt_text
              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;

3. Panggil Prosedure (bisa dengan Botton/menu)

Begin
l_pkg_gen_xl.init;
l_pkg_gen_xl.l_print_block(:system.cursor_block ,'Y','Y','N' );
l_pkg_gen_xl.save_xl('C:\temp','myexcel');
l_pkg_gen_xl.release_xl;
End;

2 comments:

  1. Hahа I shared this mуsеlf. It's really funny.

    Feel free to surf to my web blog; long term loans bad credit uk

    ReplyDelete
  2. I have ѕpent all of my ԁay reаding
    all thеse аrtісlеs. But this
    is stіll more productіve thаn yesterday!
    . At least I'll learn something new.

    My website - bad credit personal loans

    ReplyDelete