Monday 17 April 2017

Excel output with Coloured Cell

The following program has been copied from here. Only a small change has been made for the cell colour so that the background remains transparent and only the heading have a cell colour. The followings are the valid colour indexes:



*&---------------------------------------------------------------------*
*& Report  ZEXCEL
*&
*&---------------------------------------------------------------------*
*&
*& EXCEL OUTPUT WITH CELL COLOURING
*&---------------------------------------------------------------------*

REPORT zexcel.

INCLUDE ole2incl.
FIELD-SYMBOLS: <val> TYPE any.
DATA: row_cnt TYPE i.
TYPES: BEGIN OF t_excel,
  material_info(20),
  sugg_price(20),
  cost(20),
  comments(100),
END OF t_excel.
DATA: r_excel TYPE t_excel.
DATA: i_excel TYPE TABLE OF t_excel WITH HEADER LINE.
CONSTANTS:
  xlcenter TYPE i VALUE '-4108',
  xlbottom TYPE i VALUE '-4107',
  xlleft TYPE i VALUE '-4131',
  xlright TYPE i VALUE '-4152'.
CONSTANTS:
  xlcontinuous TYPE i VALUE '1',
  xlinsidevertical TYPE i VALUE '11',
  xlthin TYPE i VALUE '2',
  xllandscape TYPE i VALUE '2',
  xlportrait TYPE i VALUE '1',
  xlletter TYPE i VALUE '1',
  xllegal TYPE i VALUE '5',
  xlthick TYPE i VALUE '4',
  xlnone TYPE i VALUE '-4142',
  xlautomatic TYPE i VALUE '-4105'.
DATA:
  hexcel TYPE ole2_object, " Excel object
  hworkbooks TYPE ole2_object, " list of workbooks
  hworkbook TYPE ole2_object, " workbook
  hsheet TYPE ole2_object, " worksheet object
  hrange TYPE ole2_object, " range object
  hrange2 TYPE ole2_object, " range object
  hborders TYPE ole2_object, " Border object
  hinterior TYPE ole2_object, " interior object - for coloring
  hcolumn TYPE ole2_object, "column
  hcell TYPE ole2_object, " cell
  hfont TYPE ole2_object, " font
  hselected TYPE ole2_object, " range object
  hpicture TYPE ole2_object, "picture object
  hlogo TYPE ole2_object. "Logo object


SELECTION-SCREEN BEGIN OF BLOCK b1.
SELECTION-SCREEN SKIP 1.
PARAMETER: wraptext AS CHECKBOX.
SELECTION-SCREEN END OF BLOCK b1.


row_cnt = 1.
PERFORM build_dummy_vals.
PERFORM start_excel.
PERFORM build_header_line USING row_cnt.
PERFORM pass_records USING row_cnt.
PERFORM release_excel.
*&---------------------------------------------------------------------*
*&      Form  Build_Dummy_Vals
*&---------------------------------------------------------------------*
FORM build_dummy_vals .
  DATA: matnum(5) TYPE n.
  DATA: baseprice(3) TYPE n.
  DO 5 TIMES.
    matnum = matnum + 50.
    CLEAR r_excel.
    CONCATENATE 'Material ' matnum INTO r_excel-material_info
    SEPARATED BY space.
    r_excel-sugg_price = baseprice * matnum.
    r_excel-cost = ( baseprice * matnum ) / 2.
    CONCATENATE 'Comments for Material ' matnum INTO r_excel-comments
    SEPARATED BY space.
    APPEND r_excel TO i_excel.
  ENDDO.
ENDFORM. " Build_Dummy_Vals
*&---------------------------------------------------------------------*
*&      Form  Start_Excel
*&---------------------------------------------------------------------*
FORM start_excel.
  CREATE OBJECT hexcel 'EXCEL.APPLICATION'.
  PERFORM err_hdl.

*get list of workbooks, initially empty
  CALL METHOD OF
      hexcel
      'Workbooks' = hworkbooks.
  PERFORM err_hdl.

*add a new workbook
  CALL METHOD OF
      hworkbooks
      'Add'      = hworkbook.
  PERFORM err_hdl.

*Get Worksheet object.
  GET PROPERTY OF hworkbook 'ActiveSheet' = hsheet.
ENDFORM.                    "Start_Excel
*&---------------------------------------------------------------------*
*&      Form  Build_Header_Line
*&---------------------------------------------------------------------*
FORM build_header_line USING p_row_cnt.
  DATA: l_range(30).
  DATA: row_start(10).

  PERFORM fill_the_cell USING p_row_cnt 1 1 'Material'.
  PERFORM fill_the_cell USING p_row_cnt 2 1 'Suggested Price'.
  PERFORM fill_the_cell USING p_row_cnt 3 1 'Cost'.
  PERFORM fill_the_cell USING p_row_cnt 4 1 'Comments'.
  PERFORM format_column USING 1 15 xlcenter ' ' xlcenter 0.
  PERFORM format_column USING 2 10 xlcenter ' ' xlcenter 1.
  PERFORM format_column USING 3 35 xlcenter ' ' xlcenter 0.
  IF wraptext = 'X'.
    PERFORM format_column USING 4 35 xlleft ' ' xlcenter 1.
  ELSE.
    PERFORM format_column USING 4 100 xlleft ' ' xlcenter 0.
  ENDIF.

*Build the range object.
  row_start = p_row_cnt.
  CONCATENATE 'A' row_start ':D' row_start INTO l_range.
  CONDENSE l_range NO-GAPS.

*Set row color to yellow.
  CALL METHOD OF
      hexcel
      'RANGE' = hrange
    EXPORTING
      #1      = l_range.
  CALL METHOD OF
      hrange
      'Interior' = hinterior.
  SET PROPERTY OF hinterior 'ColorIndex' = 15. "6. "yellow
  p_row_cnt = p_row_cnt + 1.
ENDFORM. " Build_Header_Line
*&---------------------------------------------------------------------*
*&      Form  Format_Column
*&---------------------------------------------------------------------*
FORM format_column USING  p_colnum
                          p_colwidth
                          p_colhalign
                          p_colformat
                          p_colvalign
                          p_wraptext.
  CALL METHOD OF
      hexcel
      'COLUMNS' = hcolumn
    EXPORTING
      #1        = p_colnum. "column number
  SET PROPERTY OF hcolumn 'HorizontalAlignment' = p_colhalign.
  SET PROPERTY OF hcolumn 'VerticalAlignment' = p_colvalign.
  SET PROPERTY OF hcolumn 'ColumnWidth' = p_colwidth.
  SET PROPERTY OF hcolumn 'WrapText' = p_wraptext.
ENDFORM. " Format_Column
*&---------------------------------------------------------------------*
*&      Form  Pass_Records
*&---------------------------------------------------------------------*
FORM pass_records USING p_row_cnt.
  DATA: col_cnt TYPE i.
  DATA: l_range(30).
  DATA: row_start(10).
  col_cnt = 1.
*Pass the internal table values to the spreadsheet.
  LOOP AT i_excel INTO r_excel.
    DO 4 TIMES.
      ASSIGN COMPONENT sy-index OF STRUCTURE r_excel TO <val>.
      PERFORM fill_the_cell USING p_row_cnt col_cnt 0 <val>.
      col_cnt = col_cnt + 1. "increment column
    ENDDO.

*Build the range object.
    row_start = p_row_cnt.
    CONCATENATE 'A' row_start ':D' row_start INTO l_range.
    CONDENSE l_range NO-GAPS.

*Set row color to yellow.
    CALL METHOD OF
        hexcel
        'RANGE' = hrange
      EXPORTING
        #1      = l_range.
    CALL METHOD OF
        hrange
        'Interior' = hinterior.
*    SET PROPERTY OF hinterior 'ColorIndex' = 2. "7. "yellow
    p_row_cnt = p_row_cnt + 1. "increment row
    col_cnt = 1. "reset column to A (ie. col 1)
  ENDLOOP.
ENDFORM.                    "Pass_Records
*&---------------------------------------------------------------------*
*&      Form  Release_Excel
*&---------------------------------------------------------------------*
FORM release_excel .
  SET PROPERTY OF hexcel 'Visible' = 1.
  FREE OBJECT hexcel.
  PERFORM err_hdl.
ENDFORM. " Release_Excel
*---------------------------------------------------------------------
*FORM Fill_The_Cell
*---------------------------------------------------------------------
*
*Sets cell at coordinates i,j to value val boldtype bold *
*
*BOLD --> 1 = true, set bold ON 0 = false, set bold OFF
*---------------------------------------------------------------------
FORM fill_the_cell USING i j bold thevalue.
  CALL METHOD OF
      hexcel
      'Cells' = hcell
    EXPORTING
      #1      = i
      #2      = j.
  PERFORM err_hdl.
  SET PROPERTY OF hcell 'Value' = thevalue.
  PERFORM err_hdl.
  GET PROPERTY OF hcell 'Font' = hfont.
  PERFORM err_hdl.
  SET PROPERTY OF hfont 'Bold' = bold.
  PERFORM err_hdl.
ENDFORM.                    "Fill_The_Cell
*&---------------------------------------------------------------------*
*&      Form  ERR_HDL
*&---------------------------------------------------------------------*
FORM err_hdl.
  IF sy-subrc <> 0.
    MESSAGE i000(zz) WITH 'OLE Automation error: ' sy-subrc.
    EXIT.
  ENDIF.
ENDFORM. " ERR_HDL

No comments:

Post a Comment

Report to find CDS view of Standard Table

A small change has been made to the original program ( SAP YARD Article ) so that it can also display the common CDS used by multiple table...