REPORT ztable_field_export.
*&---------------------------------------------------------------------*
*& 选择屏幕定义
*&---------------------------------------------------------------------*
SELECTION-SCREEN BEGIN OF BLOCK b1 WITH FRAME TITLE TEXT-001.
PARAMETERS: p_file TYPE rlgrap-filename OBLIGATORY DEFAULT 'C:\temp\table_fields.xlsx'.
SELECTION-SCREEN END OF BLOCK b1.
SELECTION-SCREEN BEGIN OF BLOCK b2 WITH FRAME TITLE TEXT-002.
PARAMETERS: p_hdr TYPE c AS CHECKBOX DEFAULT 'X' USER-COMMAND hdr.
SELECTION-SCREEN END OF BLOCK b2.
SELECTION-SCREEN BEGIN OF BLOCK b3 WITH FRAME TITLE TEXT-003.
SELECT-OPTIONS: s_table FOR dd02l-tabname.
SELECTION-SCREEN END OF BLOCK b3.
*&---------------------------------------------------------------------*
*& 类型定义
*&---------------------------------------------------------------------*
TYPES: BEGIN OF ty_table_info,
tabname TYPE dd02l-tabname,
ddtext TYPE dd02t-ddtext,
contflag TYPE dd02l-contflag,
END OF ty_table_info.
TYPES: BEGIN OF ty_field_info,
tabname TYPE dd03l-tabname,
fieldname TYPE dd03l-fieldname,
position TYPE dd03l-position,
keyflag TYPE dd03l-keyflag,
rollname TYPE dd03l-rollname,
datatype TYPE dd03l-datatype,
leng TYPE dd03l-leng,
decimals TYPE dd03l-decimals,
ddtext TYPE dd04t-ddtext,
reftable TYPE dd03l-reftable,
reffield TYPE dd03l-reffield,
END OF ty_field_info.
*&---------------------------------------------------------------------*
*& 数据声明
*&---------------------------------------------------------------------*
DATA: gt_tables TYPE TABLE OF ty_table_info,
gs_table TYPE ty_table_info,
gt_fields TYPE TABLE OF ty_field_info,
gs_field TYPE ty_field_info.
DATA: go_excel TYPE ole2_object,
go_workbook TYPE ole2_object,
go_worksheets TYPE ole2_object,
go_worksheet TYPE ole2_object,
go_range TYPE ole2_object,
go_cells TYPE ole2_object,
go_hyperlink TYPE ole2_object.
DATA: gv_row TYPE i,
gv_col TYPE i,
gv_sheet_no TYPE i,
gv_filename TYPE string.
DATA: lv_field_count TYPE i,
lv_sheet_name TYPE string,
lv_link TYPE string,
lv_row_str TYPE string,
lv_col_str TYPE string,
lv_error TYPE string,
lv_fullpath TYPE string,
lv_sheet_count TYPE i,
lv_index TYPE i,
lv_col_char TYPE char2,
lv_first TYPE c,
lv_value TYPE string.
DATA: lt_ddtext TYPE TABLE OF dd02t,
ls_ddtext TYPE dd02t.
DATA: lx_error TYPE REF TO cx_root.
*&---------------------------------------------------------------------*
*& 初始化
*&---------------------------------------------------------------------*
INITIALIZATION.
TEXT-001 = '文件设置'.
TEXT-002 = '导出选项'.
TEXT-003 = '选择表名'.
*&---------------------------------------------------------------------*
*& 主程序
*&---------------------------------------------------------------------*
START-OF-SELECTION.
PERFORM get_table_data.
PERFORM create_excel_file.
PERFORM write_table_list_sheet.
PERFORM write_field_sheets.
PERFORM save_excel_file.
*&---------------------------------------------------------------------*
*& 获取表数据
*&---------------------------------------------------------------------*
FORM get_table_data.
CLEAR: gt_tables, gt_fields.
" 获取表信息
IF s_table[] IS NOT INITIAL.
SELECT a~tabname
a~contflag
b~ddtext
FROM dd02l AS a
LEFT JOIN dd02t AS b
ON a~tabname = b~tabname
AND a~as4local = b~as4local
AND a~as4vers = b~as4vers
AND b~ddlanguage = sy-langu
INTO TABLE gt_tables
WHERE a~tabname IN s_table
AND a~as4local = 'A'
AND a~as4vers = '0000'.
IF gt_tables IS INITIAL.
MESSAGE '没有找到符合条件的表' TYPE 'E'.
ENDIF.
" 获取字段信息
SELECT a~tabname
a~fieldname
a~position
a~keyflag
a~rollname
a~datatype
a~leng
a~decimals
a~reftable
a~reffield
b~ddtext
FROM dd03l AS a
LEFT JOIN dd04t AS b
ON a~rollname = b~rollname
AND a~as4local = b~as4local
AND a~as4vers = b~as4vers
AND b~ddlanguage = sy-langu
INTO TABLE gt_fields
FOR ALL ENTRIES IN gt_tables
WHERE a~tabname = gt_tables-tabname
AND a~as4local = 'A'
AND a~as4vers = '0000'
AND a~fieldname NOT LIKE '.%'
ORDER BY a~tabname, a~position.
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& 创建Excel文件
*&---------------------------------------------------------------------*
FORM create_excel_file.
DATA: lv_subrc TYPE sy-subrc.
TRY.
CREATE OBJECT go_excel 'Excel.Application'.
SET PROPERTY OF go_excel 'Visible' = 0.
SET PROPERTY OF go_excel 'DisplayAlerts' = 0.
CALL METHOD OF go_excel 'Workbooks' = go_workbook.
CALL METHOD OF go_workbook 'Add'.
CALL METHOD OF go_excel 'Worksheets' = go_worksheets.
CATCH cx_sy_create_object_error INTO lx_error.
lv_error = lx_error->get_text( ).
MESSAGE lv_error TYPE 'E'.
ENDTRY.
ENDFORM.
*&---------------------------------------------------------------------*
*& 写入表清单页签
*&---------------------------------------------------------------------*
FORM write_table_list_sheet.
DATA: lt_temp_fields TYPE TABLE OF ty_field_info,
lv_temp_count TYPE i.
FIELD-SYMBOLS: <fs_field> LIKE LINE OF gt_fields.
" 激活第一个工作表
CALL METHOD OF go_worksheets 'Item' = go_worksheet
EXPORTING
#1 = 1.
SET PROPERTY OF go_worksheet 'Name' = '表清单'.
" 写入标题行
IF p_hdr = 'X'.
PERFORM write_cell USING 1 1 '表名'.
PERFORM write_cell USING 1 2 '描述'.
PERFORM write_cell USING 1 3 '表类型'.
PERFORM write_cell USING 1 4 '字段数量'.
" 设置标题样式
CALL METHOD OF go_worksheet 'Range' = go_range
EXPORTING
#1 = 'A1'
#2 = 'D1'.
SET PROPERTY OF go_range 'Font.Bold' = 1.
SET PROPERTY OF go_range 'Interior.ColorIndex' = 15. " 灰色背景
ENDIF.
" 写入表数据
gv_row = 2.
LOOP AT gt_tables INTO gs_table.
" 表名
PERFORM write_cell USING gv_row 1 gs_table-tabname.
" 描述
PERFORM write_cell USING gv_row 2 gs_table-ddtext.
" 表类型
CASE gs_table-contflag.
WHEN 'C'. " 自定义表
PERFORM write_cell USING gv_row 3 '自定义表'.
WHEN 'G'. " 池表
PERFORM write_cell USING gv_row 3 '池表'.
WHEN 'S'. " 簇表
PERFORM write_cell USING gv_row 3 '簇表'.
WHEN 'E'. " 扩展表
PERFORM write_cell USING gv_row 3 '扩展表'.
WHEN OTHERS.
PERFORM write_cell USING gv_row 3 '其他'.
ENDCASE.
" 字段数量
CLEAR: lt_temp_fields, lv_temp_count.
LOOP AT gt_fields INTO gs_field WHERE tabname = gs_table-tabname.
lv_temp_count = lv_temp_count + 1.
ENDLOOP.
PERFORM write_cell USING gv_row 4 lv_temp_count.
" 创建超链接到对应的工作表
gv_sheet_no = sy-tabix + 1. " 第一个工作表是表清单
" 创建工作表名称
CONCATENATE '字段_' gs_table-tabname INTO lv_sheet_name.
" 工作表名称限制处理
PERFORM escape_sheet_name CHANGING lv_sheet_name.
" 创建超链接
CALL METHOD OF go_worksheet 'Cells' = go_cells
EXPORTING
#1 = gv_row
#2 = 1.
CONCATENATE '#' lv_sheet_name '!A1' INTO lv_link.
CALL METHOD OF go_worksheet 'Hyperlinks' = go_hyperlink
EXPORTING
#1 = go_cells
#2 = ''
#3 = ''
#4 = ''
#5 = lv_link.
FREE OBJECT: go_cells, go_hyperlink.
gv_row = gv_row + 1.
ENDLOOP.
" 自动调整列宽
PERFORM autofit_columns USING 4.
ENDFORM.
*&---------------------------------------------------------------------*
*& 写入字段清单页签
*&---------------------------------------------------------------------*
FORM write_field_sheets.
DATA: lv_first TYPE c.
LOOP AT gt_tables INTO gs_table.
gv_sheet_no = sy-tabix + 1. " 第一个工作表是表清单
" 添加新的工作表
IF sy-tabix = 1.
CALL METHOD OF go_worksheets 'Item' = go_worksheet
EXPORTING
#1 = gv_sheet_no.
ELSE.
CALL METHOD OF go_workbook 'Worksheets' = go_worksheets.
CALL METHOD OF go_worksheets 'Add'.
CALL METHOD OF go_worksheets 'Item' = go_worksheet
EXPORTING
#1 = gv_sheet_no.
ENDIF.
" 设置工作表名称
CONCATENATE '字段_' gs_table-tabname INTO lv_sheet_name.
PERFORM escape_sheet_name CHANGING lv_sheet_name.
TRY.
SET PROPERTY OF go_worksheet 'Name' = lv_sheet_name.
CATCH cx_ole_exception.
" 如果名称重复，添加后缀
CONCATENATE lv_sheet_name(28) '_' sy-tabix INTO lv_sheet_name.
SET PROPERTY OF go_worksheet 'Name' = lv_sheet_name.
ENDTRY.
" 写入表头信息
PERFORM write_cell USING 1 1 '表名：'.
PERFORM write_cell USING 1 2 gs_table-tabname.
PERFORM write_cell USING 2 1 '描述：'.
PERFORM write_cell USING 2 2 gs_table-ddtext.
" 写入字段标题
gv_row = 4.
IF p_hdr = 'X'.
PERFORM write_cell USING gv_row 1 '字段名'.
PERFORM write_cell USING gv_row 2 '位置'.
PERFORM write_cell USING gv_row 3 '主键'.
PERFORM write_cell USING gv_row 4 '数据元素'.
PERFORM write_cell USING gv_row 5 '数据类型'.
PERFORM write_cell USING gv_row 6 '长度'.
PERFORM write_cell USING gv_row 7 '小数位'.
PERFORM write_cell USING gv_row 8 '字段描述'.
PERFORM write_cell USING gv_row 9 '参考表'.
PERFORM write_cell USING gv_row 10 '参考字段'.
" 设置标题样式
CALL METHOD OF go_worksheet 'Range' = go_range
EXPORTING
#1 = 'A4'
#2 = 'J4'.
SET PROPERTY OF go_range 'Font.Bold' = 1.
SET PROPERTY OF go_range 'Interior.ColorIndex' = 15.
gv_row = gv_row + 1.
ENDIF.
" 写入字段数据
LOOP AT gt_fields INTO gs_field WHERE tabname = gs_table-tabname.
PERFORM write_cell USING gv_row 1 gs_field-fieldname.
PERFORM write_cell USING gv_row 2 gs_field-position.
" 主键标识
IF gs_field-keyflag = 'X'.
PERFORM write_cell USING gv_row 3 'X'.
ELSE.
PERFORM write_cell USING gv_row 3 ''.
ENDIF.
PERFORM write_cell USING gv_row 4 gs_field-rollname.
PERFORM write_cell USING gv_row 5 gs_field-datatype.
PERFORM write_cell USING gv_row 6 gs_field-leng.
PERFORM write_cell USING gv_row 7 gs_field-decimals.
PERFORM write_cell USING gv_row 8 gs_field-ddtext.
PERFORM write_cell USING gv_row 9 gs_field-reftable.
PERFORM write_cell USING gv_row 10 gs_field-reffield.
gv_row = gv_row + 1.
ENDLOOP.
" 自动调整列宽
PERFORM autofit_columns USING 10.
" 添加返回链接
CALL METHOD OF go_worksheet 'Cells' = go_cells
EXPORTING
#1 = 1
#2 = 12.
SET PROPERTY OF go_cells 'Value' = '返回表清单'.
CALL METHOD OF go_worksheet 'Hyperlinks' = go_hyperlink
EXPORTING
#1 = go_cells
#2 = ''
#3 = ''
#4 = ''
#5 = '#' & '表清单!A1'.
FREE OBJECT: go_cells, go_hyperlink, go_range.
ENDLOOP.
" 删除多余的工作表
PERFORM delete_extra_sheets.
ENDFORM.
*&---------------------------------------------------------------------*
*& 保存Excel文件
*&---------------------------------------------------------------------*
FORM save_excel_file.
lv_fullpath = p_file.
" 确保文件扩展名正确
IF lv_fullpath CS '.xlsx' OR lv_fullpath CS '.xls'.
" 已有扩展名
ELSE.
CONCATENATE lv_fullpath '.xlsx' INTO lv_fullpath.
ENDIF.
TRY.
CALL METHOD OF go_workbook 'SaveAs'
EXPORTING
#1 = lv_fullpath
#2 = 51. " xlOpenXMLWorkbook
CALL METHOD OF go_workbook 'Close'.
CALL METHOD OF go_excel 'Quit'.
PERFORM cleanup_ole_objects.
MESSAGE s398(00) WITH 'Excel文件已生成：' lv_fullpath.
CATCH cx_ole_exception INTO lx_error.
MESSAGE lx_error->get_text( ) TYPE 'E'.
ENDTRY.
ENDFORM.
*&---------------------------------------------------------------------*
*& 写入单元格
*&---------------------------------------------------------------------*
FORM write_cell USING iv_row TYPE i iv_col TYPE i iv_value TYPE any.
lv_value = iv_value.
CALL METHOD OF go_worksheet 'Cells' = go_cells
EXPORTING
#1 = iv_row
#2 = iv_col.
SET PROPERTY OF go_cells 'Value' = lv_value.
FREE OBJECT go_cells.
ENDFORM.
*&---------------------------------------------------------------------*
*& 自动调整列宽
*&---------------------------------------------------------------------*
FORM autofit_columns USING iv_col_count TYPE i.
DATA: lv_end TYPE string.
gv_col = iv_col_count.
" 将列号转换为Excel列标
IF gv_col <= 26.
lv_col_char = cl_abap_conv_out_ce=>uccp( gv_col + 64 ).
ELSE.
lv_col_char = cl_abap_conv_out_ce=>uccp( ( gv_col - 1 ) DIV 26 + 64 ).
CONCATENATE lv_col_char cl_abap_conv_out_ce=>uccp( MOD( gv_col - 1, 26 ) + 65 ) INTO lv_col_char.
ENDIF.
CONCATENATE 'A1:' lv_col_char '1000' INTO lv_end.
CALL METHOD OF go_worksheet 'Range' = go_range
EXPORTING
#1 = lv_end.
CALL METHOD OF go_range 'EntireColumn' = go_range.
CALL METHOD OF go_range 'AutoFit'.
FREE OBJECT go_range.
ENDFORM.
*&---------------------------------------------------------------------*
*& 删除多余的工作表
*&---------------------------------------------------------------------*
FORM delete_extra_sheets.
DATA: lv_temp TYPE i.
" 获取工作表总数
GET PROPERTY OF go_worksheets 'Count' = lv_sheet_count.
" 只保留需要的工作表
lv_temp = lv_sheet_count.
DO lv_temp TIMES.
lv_index = lv_sheet_count - sy-index + 1.
IF lv_index > lines( gt_tables ) + 1. " 保留表清单和工作表
CALL METHOD OF go_worksheets 'Item' = go_worksheet
EXPORTING
#1 = lv_index.
CALL METHOD OF go_worksheet 'Delete'.
ENDIF.
ENDDO.
ENDFORM.
*&---------------------------------------------------------------------*
*& 处理Excel名称特殊字符
*&---------------------------------------------------------------------*
FORM escape_sheet_name CHANGING cv_name TYPE string.
" Excel工作表名称中不能包含的字符: \ / ? * [ ] :
REPLACE ALL OCCURRENCES OF '\' IN cv_name WITH '_'.
REPLACE ALL OCCURRENCES OF '/' IN cv_name WITH '_'.
REPLACE ALL OCCURRENCES OF '?' IN cv_name WITH '_'.
REPLACE ALL OCCURRENCES OF '*' IN cv_name WITH '_'.
REPLACE ALL OCCURRENCES OF '[' IN cv_name WITH '_'.
REPLACE ALL OCCURRENCES OF ']' IN cv_name WITH '_'.
REPLACE ALL OCCURRENCES OF ':' IN cv_name WITH '_'.
" 工作表名称不能以'开头
IF cv_name(1) = ''''.
cv_name = '_' && cv_name+1.
ENDIF.
" 工作表名称不能超过31个字符
IF strlen( cv_name ) > 31.
cv_name = cv_name(31).
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& 清理OLE对象
*&---------------------------------------------------------------------*
FORM cleanup_ole_objects.
FREE: go_hyperlink, go_range, go_cells, go_worksheet,
go_worksheets, go_workbook, go_excel.
ENDFORM.
*&---------------------------------------------------------------------*
*& 文件选择对话框
*&---------------------------------------------------------------------*
AT SELECTION-SCREEN ON VALUE-REQUEST FOR p_file.
PERFORM f4_file_path.
FORM f4_file_path.
DATA: lt_file_table TYPE filetable,
lv_rc TYPE i,
lv_action TYPE i,
lv_path TYPE string,
lv_fullpath TYPE string.
CALL METHOD cl_gui_frontend_services=>file_save_dialog
EXPORTING
window_title = '保存Excel文件'
default_extension = 'xlsx'
default_file_name = 'table_fields.xlsx'
file_filter = 'Excel文件 (*.xlsx)|*.xlsx|所有文件 (*.*)|*.*'
CHANGING
filename = p_file
path = lv_path
fullpath = lv_fullpath
user_action = lv_action
file_table = lt_file_table
EXCEPTIONS
cntl_error = 1
error_no_gui = 2
not_supported_by_gui = 3
OTHERS = 4.
IF sy-subrc = 0 AND lv_action = cl_gui_frontend_services=>action_ok.
p_file = lv_fullpath.
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& 结束选择
*&---------------------------------------------------------------------*
END-OF-SELECTION.
" 程序结束