* Marc Hoffmann HSE Consulting LLC, OrionFoodSystems LLC
* Written on 46B in 2003
*
* P_EXVIS Excel visible
* P_WORKBK Number of workbooks to create
* P_WSHEET Number of sheets per workbook
*
PARAMETERS: p_fname LIKE rlgrap-filename DEFAULT 'C:/temp/testNN.xls'.
DATA: fname LIKE p_fname,
kn LIKE sy-repid.
DATA: cnt TYPE i VALUE 0.
DATA: itab LIKE TABLE OF kna1 WITH HEADER LINE .
DATA: sheetname(10) VALUE 'TEST ',c_row TYPE i,
scnt TYPE i,
val(20), wb(2).
PARAMETERS:
p_workbk(2) TYPE p DEFAULT '01',
p_wsheet(2) TYPE p DEFAULT '01',
p_exvis AS CHECKBOX DEFAULT 'X' .
CONSTANTS: ok TYPE i VALUE 0.
INCLUDE ole2incl.
DATA: excel_obj TYPE ole2_object,
workbook_obj TYPE ole2_object,
sheet_obj TYPE ole2_object,
cell_obj TYPE ole2_object,
cell1_obj TYPE ole2_object,
column_obj TYPE ole2_object,
range_obj TYPE ole2_object,
borders_obj TYPE ole2_object,
button_obj TYPE ole2_object,
int_obj TYPE ole2_object,
font_obj TYPE ole2_object,
row_obj TYPE ole2_object.
DATA: application TYPE ole2_object,
book TYPE ole2_object,
books TYPE ole2_object.
DATA: ole_book TYPE ole2_object.
DO p_workbk TIMES.
MOVE p_fname TO fname.
UNPACK sy-index TO wb.
REPLACE 'NN' WITH wb INTO fname.
*
PERFORM create_excel_obj.
* create sheets and save
PERFORM sheet.
PERFORM save_book.
perform open_workbook .
ENDDO.
WRITE: ' Done'.
*---------------------------------------------------------------------*
* FORM create_Excel_Obj *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM create_excel_obj.
CREATE OBJECT excel_obj 'excel.APPLICATION'.
IF sy-subrc NE 0.
WRITE: / 'No Excel creation possible'.
STOP.
ENDIF.
SET PROPERTY OF excel_obj 'DisplayAlerts' = 0.
CALL METHOD OF excel_obj 'WORKBOOKS' = workbook_obj .
* Put Excel in background
IF p_exvis EQ 'X'.
SET PROPERTY OF excel_obj 'VISIBLE' = 1.
ELSE.
SET PROPERTY OF excel_obj 'VISIBLE' = 0.
ENDIF.
* Create worksheet
SET PROPERTY OF excel_obj 'SheetsInNewWorkbook' = 1.
CALL METHOD OF workbook_obj 'ADD'.
ENDFORM. "create_Excel_Obj
*---------------------------------------------------------------------*
* FORM save_book *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM save_book.
GET PROPERTY OF excel_obj 'ActiveSheet' = sheet_obj.
FREE OBJECT sheet_obj.
FREE OBJECT workbook_obj.
GET PROPERTY OF excel_obj 'ActiveWorkbook' = workbook_obj.
CALL METHOD OF workbook_obj 'SAVEAS'
EXPORTING
#1 = fname
#2 = 1.
CALL METHOD OF workbook_obj 'CLOSE'.
* CALL METHOD OF workbook_obj 'OPEN'
* EXPORTING
* #1 = 'c:/xl.xls' .
CALL METHOD OF excel_obj 'QUIT'.
FREE OBJECT sheet_obj.
FREE OBJECT workbook_obj.
FREE OBJECT excel_obj.
ENDFORM. "save_book
*---------------------------------------------------------------------*
* FORM sheet *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM sheet.
DO p_wsheet TIMES.
UNPACK sy-index TO sheetname+5(2).
IF sy-index GT 1.
CALL METHOD OF excel_obj 'WORKSHEETS' = sheet_obj.
CALL METHOD OF sheet_obj 'ADD'.
FREE OBJECT sheet_obj.
ENDIF.
scnt = sy-index.
CALL METHOD OF excel_obj 'WORKSHEETS' = sheet_obj
EXPORTING
#1 = scnt.
CALL METHOD OF sheet_obj 'ACTIVATE'.
SET PROPERTY OF sheet_obj 'NAME' = sheetname.
FREE OBJECT sheet_obj. "OK
PERFORM fill_sheet.
*
CALL METHOD OF excel_obj 'Columns' = column_obj.
CALL METHOD OF column_obj 'Autofit'.
FREE OBJECT column_obj.
*
* call method of sheet_obj 'BUTTON' = button_obj.
* call method of button_obj 'ADD'
* exporting #1 = '10' #2 = '10' #3 = '10' #4 = '12'.
* set property of button_obj 'fmButtonStyle' = 0.
* set property of button_obj 'Characters' = 'ButtonTest'.
PERFORM rowheight USING '11:17' '8.12'.
PERFORM columnwidth USING 'c:e' '8' .
PERFORM borderrange USING 'a19:b25' .
FREE OBJECT button_obj.
FREE OBJECT font_obj.
FREE OBJECT int_obj.
FREE OBJECT cell_obj.
FREE OBJECT: cell1_obj.
FREE OBJECT range_obj.
FREE OBJECT borders_obj.
FREE OBJECT: column_obj, row_obj.
ENDDO.
FREE OBJECT font_obj.
FREE OBJECT int_obj.
FREE OBJECT cell_obj.
FREE OBJECT cell1_obj.
FREE OBJECT range_obj.
FREE OBJECT borders_obj.
FREE OBJECT column_obj.
FREE OBJECT row_obj.
FREE OBJECT sheet_obj.
ENDFORM. "sheet
*---------------------------------------------------------------------*
* FORM border *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> we *
*---------------------------------------------------------------------*
FORM border USING we.
*left
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '1'.
SET PROPERTY OF borders_obj 'LineStyle' = '1'.
SET PROPERTY OF borders_obj 'WEIGHT' = we. "4=max
SET PROPERTY OF borders_obj 'ColorIndex' = '1'.
FREE OBJECT borders_obj.
* right
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '2'.
SET PROPERTY OF borders_obj 'LineStyle' = '2'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '2'.
FREE OBJECT borders_obj.
* top
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '3'.
SET PROPERTY OF borders_obj 'LineStyle' = '3'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '3'.
FREE OBJECT borders_obj.
* bottom
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '4'.
SET PROPERTY OF borders_obj 'LineStyle' = '4'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '4'.
FREE OBJECT borders_obj.
ENDFORM. "border
*---------------------------------------------------------------------*
* FORM border2 *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> we *
*---------------------------------------------------------------------*
FORM border2 USING we.
*left
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '1'.
SET PROPERTY OF borders_obj 'LineStyle' = '5'.
SET PROPERTY OF borders_obj 'WEIGHT' = we. "4=max
SET PROPERTY OF borders_obj 'ColorIndex' = '5'.
FREE OBJECT borders_obj.
* right
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '2'.
SET PROPERTY OF borders_obj 'LineStyle' = '6'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '6'.
FREE OBJECT borders_obj.
* top
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '3'.
SET PROPERTY OF borders_obj 'LineStyle' = '7'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '7'.
FREE OBJECT borders_obj.
* bottom
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '4'.
SET PROPERTY OF borders_obj 'LineStyle' = '8'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '8'.
FREE OBJECT borders_obj.
ENDFORM. "border2
*---------------------------------------------------------------------*
* FORM border3 *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> we *
*---------------------------------------------------------------------*
FORM border3 USING we.
*left
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '1'.
SET PROPERTY OF borders_obj 'LineStyle' = '9'.
SET PROPERTY OF borders_obj 'WEIGHT' = we. "4=max
SET PROPERTY OF borders_obj 'ColorIndex' = '9'.
FREE OBJECT borders_obj.
* right
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '2'.
SET PROPERTY OF borders_obj 'LineStyle' = '10'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '10'.
FREE OBJECT borders_obj.
* top
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '3'.
SET PROPERTY OF borders_obj 'LineStyle' = '11'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '11'.
FREE OBJECT borders_obj.
* bottom
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = '4'.
SET PROPERTY OF borders_obj 'LineStyle' = '12'.
SET PROPERTY OF borders_obj 'WEIGHT' = we.
SET PROPERTY OF borders_obj 'ColorIndex' = '3'.
FREE OBJECT borders_obj.
ENDFORM. "border3
*---------------------------------------------------------------------*
* FORM fill_cell *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> color *
* --> pattern *
*---------------------------------------------------------------------*
FORM fill_cell USING color pattern.
CALL METHOD OF cell_obj 'INTERIOR' = int_obj.
SET PROPERTY OF int_obj 'ColorIndex' = color.
SET PROPERTY OF int_obj 'Pattern' = pattern.
FREE OBJECT int_obj.
ENDFORM. "fill_cell
*---------------------------------------------------------------------*
* FORM font *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> bold *
* --> size *
*---------------------------------------------------------------------*
FORM font USING bold size.
CALL METHOD OF cell_obj 'FONT' = font_obj.
SET PROPERTY OF font_obj 'BOLD' = bold.
SET PROPERTY OF font_obj 'SIZE' = size.
FREE OBJECT font_obj.
ENDFORM. "font
*---------------------------------------------------------------------*
* FORM fill_sheet *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM fill_sheet.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'A1:B3'.
PERFORM font USING 1 '14'.
SET PROPERTY OF cell_obj 'VALUE' = 'Counter'.
PERFORM fill_cell USING '15' '1'.
PERFORM border USING '2'.
FREE OBJECT cell_obj.
val = 'Workbook-Count'.
MOVE wb TO val+16.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'B1'.
SET PROPERTY OF cell_obj 'VALUE' = val.
PERFORM fill_cell USING '14' '1'.
PERFORM border USING '4'.
FREE OBJECT cell_obj.
val = 'Sheet-Count'.
UNPACK sy-index TO val+12.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'C1'.
SET PROPERTY OF cell_obj 'VALUE' = val.
PERFORM fill_cell USING '12' '1'.
PERFORM border USING '4'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'E3'.
PERFORM border USING '1'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'E5'.
PERFORM border USING '2'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'E7'.
PERFORM border USING '3'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'E9'.
PERFORM border USING '4'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'a8:b9'.
PERFORM border2 USING '2'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'F5'.
PERFORM border2 USING '2'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'F7'.
PERFORM border2 USING '3'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'F9'.
PERFORM border2 USING '4'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'G3'.
PERFORM border3 USING '1'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'G5'.
PERFORM border3 USING '2'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'G7'.
PERFORM border3 USING '3'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'G9'.
PERFORM border3 USING '4'.
FREE OBJECT cell_obj.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'A5'.
SET PROPERTY OF cell_obj 'NumberFormatLocal' = '@' .
SET PROPERTY OF cell_obj 'VALUE' = '123E5' .
CALL METHOD OF cell_obj 'ClearContents'.
FREE OBJECT cell_obj.
** MERGE
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = 'A5:A7'.
CALL METHOD OF cell_obj 'MERGE' .
FREE OBJECT cell_obj.
**
val = 'ROW-Count'.
DO 19 TIMES.
c_row = sy-index + 1.
UNPACK c_row TO val+12(4).
CALL METHOD OF excel_obj 'CELLS' = cell1_obj
EXPORTING
#1 = c_row
#2 = 2.
SET PROPERTY OF cell1_obj 'VALUE' = val.
FREE OBJECT cell1_obj.
CALL METHOD OF excel_obj 'CELLS' = cell1_obj
EXPORTING
#1 = c_row
#2 = 4.
SET PROPERTY OF cell1_obj 'VALUE' = val.
FREE OBJECT cell1_obj.
ENDDO.
ENDFORM. "fill_sheet
*&--------------------------------------------------------------------*
*& Form fill_sheet_itab
*&--------------------------------------------------------------------*
* text
*---------------------------------------------------------------------*
FORM fill_sheet_itab.
DATA: row_max TYPE i VALUE 256 ,
rows TYPE i VALUE 1 ,
index TYPE i .
FIELD-SYMBOLS: <name> .
LOOP AT itab .
rows = rows + 1. "至第ROWS列
index = row_max * ( rows - 1 ) + 1.
DO 20 TIMES. "如要每一列放入10個存格的數據
ASSIGN COMPONENT sy-index OF STRUCTURE itab TO <name> .
CALL METHOD OF sheet_obj 'Cells' = cell_obj
EXPORTING
#1 = index.
SET PROPERTY OF cell_obj 'Value' = <name>.
ADD 1 TO index.
ENDDO.
ENDLOOP.
ENDFORM. "FILL_SHEET
*&--------------------------------------------------------------------*
*& Form rowheight
*&--------------------------------------------------------------------*
* text
*---------------------------------------------------------------------*
* -->HEIGHT text
*---------------------------------------------------------------------*
FORM rowheight USING row height .
CALL METHOD OF excel_obj 'ROWS' = row_obj
EXPORTING
#1 = row.
SET PROPERTY OF row_obj 'RowHeight' = height .
FREE OBJECT row_obj.
ENDFORM . "rowheight
*&--------------------------------------------------------------------*
*& Form ColumnWidth
*&--------------------------------------------------------------------*
* text
*---------------------------------------------------------------------*
* -->WIDTH text
*---------------------------------------------------------------------*
FORM columnwidth USING column width .
CALL METHOD OF excel_obj 'COLUMNS' = column_obj
EXPORTING
#1 = column.
SET PROPERTY OF column_obj 'columnwidth' = width .
FREE OBJECT column_obj.
ENDFORM . "columnwidth
*&--------------------------------------------------------------------*
*& Form borderrange
*&--------------------------------------------------------------------*
* text
*---------------------------------------------------------------------*
* -->WE text
*---------------------------------------------------------------------*
FORM borderrange USING range.
CALL METHOD OF excel_obj 'RANGE' = cell_obj
EXPORTING
#1 = range.
DO 4 TIMES .
CALL METHOD OF cell_obj 'BORDERS' = borders_obj
EXPORTING
#1 = sy-index.
SET PROPERTY OF borders_obj 'LineStyle' = '1'.
SET PROPERTY OF borders_obj 'WEIGHT' = 2. "4=max
* SET PROPERTY OF borders_obj 'ColorIndex' = '1'.
FREE OBJECT borders_obj.
ENDDO.
FREE OBJECT borders_obj.
FREE OBJECT cell_obj.
ENDFORM. "borderrange
*----------------------------------------------------------------------*
* You find SAP OLE programs under development Class 'SOLE' *
* *
* MSTAPPL Table Maintenance APPL *
* RSOLEDOC Document list *
* RSOLEIN0 OLE Load Type Information *
* RSOLEINT Type Info Loaded *
* RSOLETI0 OLE Object Browser *
* RSOLETI1 OLE Object Browser *
* RSOLETI2 OLE Object Browser *
* RSOLETI3 F4 Help For OLE Objects *
* RSOLETT1 OLE 2.0 Automation Demo Program *
* *
* Transactions: *
* SOLE *
* SOLO - List of OLE applcations with loaded type info *
* *
* *
* You will find the decription of possible objects and methods in the *
* windows help file for Excel. *
*----------------------------------------------------------------------*
*CALL METHOD OF EXCEL_OBJ 'WORKBOOKS'
* 'QUIT'
* 'WORKSHEETS'
* 'COLUMNS'
* 'RANGE'
* 'CELLS'
*&---------------------------------------------------------------------*
*& Form open_excel
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
form open_workbook .
endform. " open_excel
