1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
   |  
PROCEDURE Export_to_Excel(p_block_name IN VARCHAR2 DEFAULT NAME_IN('system.current_block')) IS 
 
   myTab                    CONSTANT varchar2(1) := chr(9); 
   myBlue                   CONSTANT number(8) := 16711680; --FF0000
   myGreen                  CONSTANT number(8) := 65280;    --00FF00
   myRed                    CONSTANT number(8) := 255;      --0000FF
   myDkGreen                CONSTANT number(8) := 32768;    --008000
   myBlack                  CONSTANT number(8) := 0;        --000000
 
-- Declare the OLE objects 
application OLE2.OBJ_TYPE; 
workbooks OLE2.OBJ_TYPE; 
workbook OLE2.OBJ_TYPE; 
worksheets OLE2.OBJ_TYPE; 
worksheet OLE2.OBJ_TYPE; 
cell OLE2.OBJ_TYPE; 
range OLE2.OBJ_TYPE; 
range_col OLE2.OBJ_TYPE; 
Font                    OLE2.OBJ_TYPE;
hSelection                   OLE2.OBJ_TYPE;
Workinterior                    OLE2.OBJ_TYPE;
 
 
-- Declare handles to OLE argument lists 
args OLE2.LIST_TYPE; 
-- Declare form and block items 
form_name VARCHAR2(100); 
f_block VARCHAR2(100); 
l_block VARCHAR2(100); 
f_item VARCHAR2(100); 
l_item VARCHAR2(100); 
cur_block VARCHAR2(100) := NAME_IN('system.current_block'); 
cur_item VARCHAR2(100) := NAME_IN('system.current_item'); 
cur_record VARCHAR2(100) := NAME_IN('system.cursor_record'); 
item_name VARCHAR2(100); 
baslik VARCHAR2(100); 
row_n NUMBER; 
col_n NUMBER; 
filename VARCHAR2(100) :=to_char(sysdate,'YYYMMDD_HH24MI')||'_'||p_block_name;
 
BEGIN 
	begin
-- Start Excel 
application:=OLE2.CREATE_OBJ('Excel.Application'); 
OLE2.SET_PROPERTY(application, 'Visible', 'True'); 
--Ole2.Set_property(application, 'Name', filename);
 
-- Return object handle to the Workbooks collection 
workbooks:=OLE2.GET_OBJ_PROPERTY(application, 'Workbooks'); 
 
--
-- Add a new Workbook object to the Workbooks collection 
workbook:=OLE2.GET_OBJ_PROPERTY(workbooks,'Add'); 
 
-- Return object handle to the Worksheets collection for the Workbook 
worksheets:=OLE2.GET_OBJ_PROPERTY(workbook, 'Worksheets'); 
 
-- Get the first Worksheet in the Worksheets collection 
-- worksheet:=OLE2.GET_OBJ_PROPERTY(worksheets,'Add'); 
args:=OLE2.CREATE_ARGLIST; 
OLE2.ADD_ARG(args, 1); 
worksheet:=OLE2.GET_OBJ_PROPERTY(worksheets,'Item', args); 
OLE2.DESTROY_ARGLIST(args); 
Ole2.Set_property(worksheet, 'Name', filename);
 
/*
Ole_Excel.worksheet := Ole2.Get_Obj_Property(Ole_Excel.application, 'ActiveSheet');
*/
 
 
-- Return object handle to cell A1 on the new Worksheet 
go_block(p_block_name); 
baslik := get_block_property(p_block_name,FIRST_ITEM); 
f_item := p_block_name||'.'||get_block_property(p_block_name, FIRST_ITEM); 
l_item := p_block_name||'.'||get_block_property(p_block_name, LAST_ITEM); 
 
 
first_record; 
LOOP 
	item_name := f_item; 
	row_n := NAME_IN('SYSTEM.CURSOR_RECORD'); 
	col_n := 0; 
   LOOP 
	IF-- get_item_property(item_name,ITEM_TYPE)='TEXT ITEM' AND 
	get_item_property(item_name,ITEM_TYPE)not in ('BUTTON','IMAGE') 
	AND get_item_property(item_name,VISIBLE)='TRUE' 
	THEN 
									col_n:=col_n+1;
									-- Set first row with the item names 
									IF row_n=1 THEN 
								baslik:=NVL(get_item_property(item_name,PROMPT_TEXT ),baslik); 
	args:=OLE2.CREATE_ARGLIST; 
	OLE2.ADD_ARG(args, row_n); 
	OLE2.ADD_ARG(args, col_n); 
	cell:=OLE2.GET_OBJ_PROPERTY(worksheet, 'Cells', args); 
	OLE2.DESTROY_ARGLIST(args); 
	OLE2.SET_PROPERTY(cell, 'Value', baslik); 
	font := OLE2.GET_OBJ_PROPERTY(cell, 'Font');
	OLE2.SET_PROPERTY(font, 'Name', 'ARIAL');
	OLE2.SET_PROPERTY(font, 'Size', 10);
	OLE2.SET_PROPERTY(font, 'Bold', 'True');
             OLE2.RELEASE_OBJ(font);
             WorkInterior := ole2.Get_Obj_Property(cell, 'Interior');
	OLE2.SET_PROPERTY(WorkInterior, 'ColorIndex',15);--col_n+4); 
	OLE2.RELEASE_OBJ(WorkInterior);
	OLE2.RELEASE_OBJ(cell); 
	END IF; 
	-- Set other rows with the item values 
	args:=OLE2.CREATE_ARGLIST; 
	OLE2.ADD_ARG(args, row_n+1); 
	OLE2.ADD_ARG(args, col_n); 
	cell:=OLE2.GET_OBJ_PROPERTY(worksheet, 'Cells', args); 
	OLE2.DESTROY_ARGLIST(args); 
	IF get_item_property(item_name,DATATYPE)<>'NUMBER' THEN 
	        OLE2.SET_PROPERTY(cell, 'NumberFormat', '@');
             END IF; 
	 font := OLE2.GET_OBJ_PROPERTY(cell, 'Font');
	OLE2.SET_PROPERTY(font, 'Size', 8);
	OLE2.SET_PROPERTY(font, 'Name', 'ARIAL');
	OLE2.SET_PROPERTY(font, 'Bold', 'false');
	OLE2.RELEASE_OBJ(font);
	OLE2.RELEASE_OBJ(cell); 
         END IF; 
         IF item_name = l_item THEN  
	exit
         END IF; 
         baslik := get_item_property(item_name,NEXTITEM); 
         item_name := p_block_name||'.'||get_item_property(item_name,NEXTITEM); 
END LOOP; 
EXIT WHEN NAME_IN('system.last_record') = 'TRUE'; 
NEXT_RECORD; 
END LOOP; 
 
-- Autofit columns 
range := OLE2.GET_OBJ_PROPERTY( worksheet,'UsedRange'); 
range_col := OLE2.GET_OBJ_PROPERTY( range,'Columns'); 
OLE2.INVOKE( range_col,'AutoFit' ); 
OLE2.RELEASE_OBJ( range ); 
OLE2.RELEASE_OBJ( range_col ); 
 
args := OLE2.CREATE_ARGLIST;
OLE2.ADD_ARG( args,filename );
OLE2.INVOKE( worksheet,'Save',args );
OLE2.DESTROY_ARGLIST( args );
/*
 
-- Get filename and path 
args := OLE2.CREATE_ARGLIST; 
OLE2.ADD_ARG( args, p_block_name ); 
OLE2.ADD_ARG( args,'Excel Workbooks (*.xls, *.xls'); 
filename := OLE2.INVOKE_CHAR(application,'GetSaveAsFilename',args ); 
OLE2.DESTROY_ARGLIST(args); 
 
 
-- Save as worksheet 
args := OLE2.CREATE_ARGLIST; 
OLE2.ADD_ARG( args,filename ); 
OLE2.INVOKE( worksheet,'Save',args ); 
OLE2.DESTROY_ARGLIST( args ); 
*/
 
OLE2.Release_Obj(worksheet);
OLE2.Release_Obj(worksheets);
OLE2.Release_Obj(workbooks);
OLE2.Release_Obj(application);
 
-- Close wo
EXCEPTION when others then begin message('exception'||substr(SQLERRM,1,200));pause;raise;end;
end;
end; | 
Partager