SAP DOI EXCEL宏的使用
OAOR里上传EXCEL模版
屏幕初始化PBO创建DOI EXCEL对象，并填充EXCEL内容
*&---------------------------------------------------------------------*
*& Module INIT_DOI_DISPLAY_9100 OUTPUT
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
MODULE init_doi_display_9100 OUTPUT.
IF gc_container IS INITIAL.
PERFORM frm_doi_create USING gs_temp_name. "创建DOI对象
IF gs_mode <> 'U'.
PERFORM frm_fill_sheets_data . "填写SHEET数据
ENDIF.
ENDIF.
ENDMODULE.
*&---------------------------------------------------------------------*
*& Form FRM_DOI_OAOR_URL
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_ITEM_URL text
* -->P_I_TEMP_NAME text
*----------------------------------------------------------------------*
FORM frm_doi_oaor_url USING ev_url i_temp_name.
DATA lv_classname TYPE sbdst_classname VALUE 'SOFFICEINTEGRATION'.
DATA lv_classtype TYPE sbdst_classtype VALUE 'OT'.
DATA lv_object_key TYPE sbdst_object_key VALUE 'ZFI'.
DATA lcl_instance TYPE REF TO cl_bds_document_set.
DATA lt_signature TYPE sbdst_signature.
DATA ls_signature LIKE LINE OF lt_signature.
DATA lt_components TYPE sbdst_components.
DATA lt_uris TYPE sbdst_uri.
DATA ls_uris LIKE LINE OF lt_uris.
"1.DESCRIPTION 根据描述定位模板
2.BDS_KEYWORD 根据关键字定位模板
ls_signature-prop_name = 'BDS_KEYWORD'.
ls_signature-prop_value = i_temp_name.
APPEND ls_signature TO lt_signature.
CREATE OBJECT lcl_instance.
CALL METHOD lcl_instance->get_info
EXPORTING
classname = lv_classname
classtype = lv_classtype
object_key = lv_object_key
CHANGING
components = lt_components
signature = lt_signature
EXCEPTIONS
nothing_found = 1
error_kpro = 2
internal_error = 3
parameter_error = 4
not_authorized = 5
not_allowed = 6.
CALL METHOD lcl_instance->get_with_url
EXPORTING
classname = lv_classname
classtype = lv_classtype
object_key = lv_object_key
CHANGING
uris = lt_uris
signature = lt_signature.
DATA lt_table TYPE sbdst_content.
CALL METHOD lcl_instance->get_with_table
EXPORTING
classname = lv_classname
classtype = lv_classtype
object_key = lv_object_key
CHANGING
content = lt_table
signature = lt_signature.
FREE lcl_instance.
SORT lt_uris BY doc_count DESCENDING.
READ TABLE lt_uris INTO ls_uris INDEX 1.
ev_url = ls_uris-uri.
ENDFORM. " FRM_DOI_OAOR_URL
*&---------------------------------------------------------------------*
*& Form FRM_DOI_CREATE
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_GS_TEMP_NAME text
*----------------------------------------------------------------------*
FORM frm_doi_create USING i_temp_name.
DATA item_url TYPE c LENGTH 256.
DATA lv_filename TYPE string.
DATA lv_rc TYPE i.
DATA has TYPE i.
DATA: cl_splitter TYPE REF TO cl_gui_splitter_container,
cl_container TYPE REF TO cl_gui_container.
PERFORM frm_display_percent USING 1 '正在打开模板文件，请等待......' .
"创建DOI Control
CALL METHOD c_oi_container_control_creator=>get_container_control
IMPORTING
control = gi_control.
"创建CONTIANER
CREATE OBJECT gc_container
EXPORTING
container_name = 'CONTAINER_9100'.
CALL METHOD gi_control->init_control
EXPORTING
r3_application_name = 'XX平台报表'
inplace_enabled = 'X'
inplace_scroll_documents = 'X'
parent = gc_container
register_on_close_event = 'X'
register_on_custom_event = 'X'
no_flush = 'X'.
* 读取服务器上模板文件
IF gs_mode <> 'U'.
PERFORM frm_doi_oaor_url USING item_url i_temp_name. "OAOR里的EXCEL模版url 注：大模版打开可能很慢
ELSE.
item_url = gv_url.
ENDIF.
CALL METHOD gi_control->get_document_proxy
EXPORTING
document_type = 'Excel.Sheet'
no_flush = 'X'
IMPORTING
document_proxy = gi_document
error = gi_error.
"打开excel
CALL METHOD gi_document->open_document
EXPORTING
open_inplace = 'X'
no_flush = ''
document_url = item_url
IMPORTING
error = gi_error.
CALL METHOD gi_document->has_spreadsheet_interface
EXPORTING
no_flush = ''
IMPORTING
is_available = has.
CALL METHOD gi_document->get_spreadsheet_interface
EXPORTING
no_flush = ''
IMPORTING
sheet_interface = gi_spreadsheet.
IF gi_spreadsheet IS INITIAL.
MESSAGE '打开EXCEL失败,请删除任务管理器中的Excel进程再执行' TYPE 'S' DISPLAY LIKE 'E'.
REJECT.
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form FRM_DISPLAY_PERCENT
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_100 text
* -->P_0024 text
*----------------------------------------------------------------------*
FORM frm_display_percent USING iv_percentage iv_msg.
DATA lv_text TYPE string.
WHILE gv_percentage < iv_percentage.
gv_percentage = gv_percentage + 1.
MESSAGE s001(00) WITH gv_percentage '%:' iv_msg INTO lv_text.
CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
text = lv_text
EXCEPTIONS
OTHERS = 1.
PERFORM frm_wait_seconds USING '0.01'.
ENDWHILE.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form FRM_WAIT_SECONDS
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_0255 text
*----------------------------------------------------------------------*
FORM frm_wait_seconds USING iv_seconds TYPE p.
DATA lv_runtime1 TYPE i.
DATA lv_runtime2 TYPE i.
DATA lv_seconds TYPE i.
lv_seconds = iv_seconds * 1000000.
GET RUN TIME FIELD lv_runtime1.
WHILE lv_runtime2 - lv_runtime1 < lv_seconds.
GET RUN TIME FIELD lv_runtime2.
ENDWHILE.
ENDFORM.
填充EXCEL内容
*&---------------------------------------------------------------------*
*& Form FRM_FILL_SHEETS_DATA
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM frm_fill_sheets_data.
DATA wa_sheet TYPE soi_sheets.
DATA lv_error TYPE REF TO i_oi_error.
CALL METHOD gi_spreadsheet->get_sheets
IMPORTING
sheets = gt_sheets
error = lv_error.
"读取excel异常
CALL METHOD lv_error->raise_message
EXPORTING
type = 'E'.
PERFORM frm_set_calculation USING 'False'. "关闭自动计算，提高代码执行效率
PERFORM frm_set_fn_corr_excel CHANGING gt_ztfi1249_b06. "☆重要：设置战役内表字段对应EXCEL列
PERFORM frm_get_excel_cols CHANGING gt_ztfi1249_b07. "EXCEL页签总列数
PERFORM frm_fill_sheet_data_0. "Sheet页签：0
LOOP AT gt_sheets INTO wa_sheet.
CASE wa_sheet-sheet_name.
WHEN '创利0'.
"创利0&全口径
PERFORM frm_copy_rows TABLES <dyn_table_z0> USING '创利0&全口径'. "复制插入行
PERFORM frm_fill_sheet_data TABLES <dyn_table_z0> USING '创利0&全口径'.
"创利0&权益
PERFORM frm_copy_rows TABLES <dyn_table_z0_1> USING '创利0&权益'. "复制插入行
PERFORM frm_fill_sheet_data TABLES <dyn_table_z0_1> USING '创利0&权益'.
WHEN '战役1'.
PERFORM frm_copy_rows TABLES <dyn_table_z1> USING wa_sheet-sheet_name. "复制插入行
PERFORM frm_fill_sheet_data TABLES <dyn_table_z1> USING wa_sheet-sheet_name.
WHEN '1.1'.
PERFORM frm_copy_rows TABLES <dyn_table_1_1> USING wa_sheet-sheet_name. "复制插入行
PERFORM frm_fill_sheet_data TABLES <dyn_table_1_1> USING wa_sheet-sheet_name.
WHEN '2.1'.
PERFORM frm_copy_rows TABLES <dyn_table_2_1> USING wa_sheet-sheet_name. "复制插入行
PERFORM frm_fill_sheet_data TABLES <dyn_table_2_1> USING wa_sheet-sheet_name.
ENDCASE.
ENDLOOP.
CALL METHOD gi_spreadsheet->select_sheet( EXPORTING no_flush = 'X' name = '创利0').
PERFORM frm_default_selection USING '创利0&全口径'. "默认光标选中行
* PERFORM frm_hide_sheet. "隐藏页签
PERFORM frm_set_calculation USING 'True'.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form FRM_SET_CALCULATION
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_0033 text
*----------------------------------------------------------------------*
FORM frm_set_calculation USING iv_flag.
CALL METHOD gi_document->execute_macro
EXPORTING
macro_string = '模块1.set_calculation'
no_flush = 'X'
param_count = 1
param1 = iv_flag
IMPORTING
error = gi_error.
ENDFORM.
FORM frm_set_fn_corr_excel CHANGING VALUE(ct_ztfi1249_b06) TYPE ztfi1249_b06_tab.
"页签字段对应EXCEL列（用于输出和保存）
IF ct_ztfi1249_b06 IS INITIAL.
SELECT * INTO TABLE ct_ztfi1249_b06 FROM ztfi1249_b06.
IF sy-subrc = 0.
SORT ct_ztfi1249_b06 BY sheet_name column_excel range.
ENDIF.
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form FRM_SET_FN_CORR_EXCEL
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM frm_get_excel_cols CHANGING VALUE(ct_ztfi1249_b07) TYPE ztfi1249_b07_tab.
" EXCEL页签总列数
IF ct_ztfi1249_b07 IS INITIAL.
SELECT * INTO TABLE ct_ztfi1249_b07 FROM ztfi1249_b07.
IF sy-subrc = 0.
SORT ct_ztfi1249_b07 BY sheet_name.
ENDIF.
ENDIF.
ENDFORM.
*----------------------------------------------------------------------*
FORM frm_fill_sheet_data_0.
DATA lv_col TYPE string.
DATA lv_row TYPE i.
"选中页签 【 0 】
CALL METHOD gi_spreadsheet->select_sheet( EXPORTING no_flush = 'X' name = '0'). "先要选中填数页签，否则数据填不进去
PERFORM frm_setcellvalue01 USING 'B4' gs_ztfi1249_01-byear. "版本年度
PERFORM frm_setcellvalue01 USING 'B5' gs_ztfi1249_01-mont. "版本月份
* SORT gt_tbgs BY pinyin.
* LOOP AT gt_tbgs INTO DATA(gs_tbgs).
* lv_row = 3 + sy-tabix.
*
* lv_col = |E{ lv_row }|.
* PERFORM frm_setcellvalue01 USING lv_col gs_tbgs-tbgs. "组织编码
*
* lv_col = |F{ lv_row }|.
* PERFORM frm_setcellvalue01 USING lv_col gs_tbgs-tbgsnm. "组织名称
* ENDLOOP.
ENDFORM.
*----------------------------------------------------------------------*
FORM frm_setcellvalue01 USING iv_cell iv_value.
CALL METHOD gi_document->execute_macro
EXPORTING
macro_string = '模块1.SetCellValue01'
param_count = 2
param1 = iv_cell
param2 = iv_value
no_flush = 'X'
IMPORTING
error = gi_error.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form FRM_COPY_ROWS
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_<DYN_TABLE_Z1> text
*----------------------------------------------------------------------*
FORM frm_copy_rows TABLES pt_excel
USING VALUE(iv_sheet_name) TYPE soi_field_name.
* VALUE(iv_copy_c) TYPE i "复制行
* VALUE(iv_copy_i) TYPE i. "插入行
DATA l_iref_error TYPE REF TO i_oi_error.
DATA lv_lines TYPE i.
DATA lv_copy_c TYPE i. "复制行
DATA lv_copy_i TYPE i. "插入行
DATA lv_sheet_name TYPE soi_field_name.
DATA lv_info TYPE char80.
* ☆☆☆☆☆比如：复制第5行，则需要在第6行插入，此时插入行才在下面。☆☆☆☆☆☆☆
"*// 起始行
READ TABLE gt_ztfi1249_b07 INTO DATA(gs_b07) WITH KEY sheet_name = iv_sheet_name BINARY SEARCH.
CASE iv_sheet_name.
WHEN '创利0&权益'.
DESCRIBE TABLE pt_excel LINES DATA(lv_lines_qy).
IF lv_lines_qy > 1.
* lv_copy_c = gv_end_row_z0 + 4. "复制行
lv_copy_c = gv_end_row_z0 + 5. "复制行
ELSE.
lv_copy_c = gv_end_row_z0 + 5. "复制行
ENDIF.
* lv_copy_c = gv_end_row_z0 + 5. "复制行
lv_copy_i = lv_copy_c + 1. "插入行
WHEN OTHERS.
lv_copy_c = gs_b07-start_row. "复制行
lv_copy_i = lv_copy_c + 1. "插入行
ENDCASE.
lv_sheet_name = iv_sheet_name.
IF lv_sheet_name CS '创利0'.
lv_sheet_name = '创利0'.
ENDIF.
lv_info = '正在填充数据：' && lv_sheet_name.
CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
text = lv_info.
"Activate a Sheet
CALL METHOD gi_spreadsheet->select_sheet
EXPORTING
no_flush = 'X'
name = lv_sheet_name
IMPORTING
error = l_iref_error.
"复制插入行
lv_lines = lines( pt_excel ).
IF iv_sheet_name = cns_sheetname8_1 OR iv_sheet_name = cns_sheetname8_1.
lv_lines = lv_lines.
ELSE.
lv_lines = lv_lines - 1.
ENDIF.
* CHECK lv_lines > 1.
CHECK lv_lines > 0.
* CALL METHOD gi_document->execute_macro
* EXPORTING
* macro_string = '模块1.SelectSheet'
* no_flush = 'X'
* param_count = 1
* param1 = iv_sheet_name
* IMPORTING
* error = gi_error.
DO lv_lines TIMES.
CALL METHOD gi_document->execute_macro
EXPORTING
macro_string = '模块1.Copy_Row_1'
no_flush = 'X'
param_count = 2
param1 = lv_copy_c "复制行 如：复制第5行，则需要在第6行插入，此时插入行才在下面。
param2 = lv_copy_i "插入行
IMPORTING
error = gi_error.
lv_copy_c = lv_copy_c + 1.
lv_copy_i = lv_copy_i + 1.
ENDDO.
ENDFORM.
* -->P_<DYN_TABLE1_1> text
*----------------------------------------------------------------------*
FORM frm_fill_sheet_data TABLES pt_table
USING VALUE(p_sheetname) TYPE soi_field_name.
DATA lv_lines TYPE i. "总行数
DATA lv_row_start TYPE i. "起始行
DATA lv_row_end TYPE i. "结束行
DATA lv_col_start TYPE i. "起始列
DATA lv_col_end TYPE i. "结束列
DATA lt_ztfi1249_b06 TYPE STANDARD TABLE OF ztfi1249_b06.
DATA lt_range TYPE STANDARD TABLE OF ztfi1249_b06.
DATA lt_date_format TYPE STANDARD TABLE OF ztfi1249_b06.
DATA lt_range_1 TYPE STANDARD TABLE OF ztfi1249_b06.
DATA lt_range_s TYPE STANDARD TABLE OF ztfi1249_b06.
DATA lt_range_e TYPE STANDARD TABLE OF ztfi1249_b06.
IF p_sheetname = '创利0&全口径'.
CLEAR gv_end_row_z0.
ENDIF.
lt_ztfi1249_b06 = gt_ztfi1249_b06.
DELETE lt_ztfi1249_b06 WHERE sheet_name <> p_sheetname.
DELETE lt_ztfi1249_b06 WHERE zoutput = ''. "排除不输出字段
lt_date_format = lt_ztfi1249_b06.
DELETE lt_date_format WHERE date_format = ''. "日期格式与转换字段，删除无配置字段
SORT lt_date_format BY fieldname.
"数据行数
DESCRIBE TABLE pt_table LINES lv_lines.
"获取当前页签字段
CLEAR lt_range.
lt_range = lt_ztfi1249_b06.
"*// 起始行
READ TABLE gt_ztfi1249_b07 INTO DATA(gs_b07) WITH KEY sheet_name = p_sheetname BINARY SEARCH.
"按 range 范围输出，所以需要去除重复，取范围（单列也算一个范围）
SORT lt_range BY range.
DELETE ADJACENT DUPLICATES FROM lt_range COMPARING range.
LOOP AT lt_range INTO DATA(ls_range).
CLEAR lt_range_s.
lt_range_s = lt_ztfi1249_b06.
DELETE lt_range_s WHERE range <> ls_range-range.
CLEAR lt_range_e.
lt_range_e = lt_ztfi1249_b06.
DELETE lt_range_e WHERE range <> ls_range-range.
SORT lt_range_s BY column_excel.
SORT lt_range_e BY column_excel DESCENDING.
READ TABLE lt_range_s INTO DATA(ls_range_s) INDEX 1. "起始列
READ TABLE lt_range_e INTO DATA(ls_range_e) INDEX 1. "结束列
CLEAR lv_row_start.
CLEAR lv_row_end.
CLEAR lv_col_start.
CLEAR lv_col_end.
lv_row_start = gs_b07-start_row. "起始行
lv_row_end = lv_lines + gs_b07-start_row - 1. "结束行
lv_col_start = ls_range_s-column_excel. "起始列
lv_col_end = ls_range_e-column_excel. "结束列
IF p_sheetname = '创利0&全口径'.
gv_end_row_z0 = lv_row_end.
ELSEIF p_sheetname = '创利0&权益'.
lv_row_start = gv_end_row_z0 + 2 + 2 + 1. "创利0&权益: 起始行 = 创利0&全口径 结束行 + 创利0&全口径 1行 合计 (包含1空行) + 权益抬头2行 + 自身1行
lv_row_end = gv_end_row_z0 + 2 + 2 + lv_lines. "创利0&权益：结束行 = 创利0&全口径 结束行 + 创利0&全口径 1行 合计 (包含1空行) + 权益抬头2行 + 创利0&权益 总行数
ENDIF.
"输出结果
PERFORM frm_doi_set_range USING gi_spreadsheet lv_row_start lv_row_end lv_col_start lv_col_end 'RANGE' gt_ranges. "设置输出range
PERFORM frm_doi_range_data_sheet TABLES pt_table USING lt_range_s lt_date_format. "设置输出内表值
PERFORM frm_doi_fill_ranges USING gi_spreadsheet gt_ranges gt_excel_input. "填充到EXCEL指定位置
CLEAR ls_range_s.
CLEAR ls_range_e.
ENDLOOP.
PERFORM frm_hide_row_columns USING p_sheetname. "隐藏列 或 行
ENDFORM.
*&---------------------------------------------------------------------*
*& Form FRM_DOI_SET_RANGE
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_GI_SPREADSHEET text
* -->P_3 text
* -->P_LV_END_ROW text
* -->P_2 text
* -->P_8 text
* -->P_0455 text
* -->P_GT_RANGES text
*----------------------------------------------------------------------*
FORM frm_doi_set_range USING io_spreadsheet TYPE REF TO i_oi_spreadsheet
row_start TYPE i "起始行
row_end TYPE i "结束行
col_start TYPE i "起始列
col_end TYPE i "结束列
name TYPE any
et_ranges TYPE soi_range_list.
DATA: lv_cols TYPE i,
lv_rows TYPE i,
lv_tabix TYPE sy-tabix,
ls_ranges TYPE LINE OF soi_range_list.
CLEAR gt_ranges.
"数据行数列数
lv_rows = row_end - row_start + 1.
lv_cols = col_end - col_start + 1.
CALL METHOD io_spreadsheet->insert_range_dim
EXPORTING
name = name
no_flush = 'X'
top = row_start "起始行
left = col_start "起始列
rows = lv_rows "结束行
columns = lv_cols. "结束列
ls_ranges-name = name.
ls_ranges-columns = lv_cols.
ls_ranges-rows = lv_rows.
ls_ranges-code = 4.
APPEND ls_ranges TO et_ranges.
ENDFORM. "frm_doi_insert_range
*&---------------------------------------------------------------------*
*& Form FRM_DOI_RANGE_DATA_SHEET1_1
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_PT_TABLE text
*----------------------------------------------------------------------*
FORM frm_doi_range_data_sheet TABLES p_table
USING VALUE(lt_range_s) TYPE ztfi1249_b06_tab
VALUE(lt_date_format) TYPE ztfi1249_b06_tab.
DATA lv_row TYPE i.
DATA lv_column TYPE i.
DATA ls_excel_input TYPE LINE OF soi_generic_table.
DATA lv_tabname TYPE tabname.
DATA lv_fieldname TYPE string.
DATA lt_flds TYPE dd03ptab.
DATA ls_flds TYPE dd03p.
DATA:dny_tab_temp TYPE REF TO data.
FIELD-SYMBOLS:<dny_tab_temp> TYPE STANDARD TABLE.
"清空
CLEAR gt_excel_input.
"读取结构
READ TABLE lt_range_s INTO DATA(ls_range_s) INDEX 1.
IF sy-subrc = 0.
lv_tabname = ls_range_s-ddobjname.
ENDIF.
"没有配置结构，则退出，防止DUMP
IF lv_tabname IS INITIAL.
RETURN.
ENDIF.
"根据结构创建动态内表
CLEAR lt_flds.
zcl_pubfm=>get_dyntab( EXPORTING iv_tabn = lv_tabname
IMPORTING er_tabl = dny_tab_temp
et_flds = lt_flds ).
"实例化指针，赋值给动态内表
ASSIGN dny_tab_temp->* TO <dny_tab_temp>.
IF p_table[] IS INITIAL. RETURN. ENDIF.
APPEND LINES OF p_table TO <dny_tab_temp>.
SORT lt_flds BY fieldname inttype.
"赋值给输出内表
LOOP AT <dny_tab_temp> ASSIGNING FIELD-SYMBOL(<ls_table>).
lv_row = lv_row + 1.
lv_column = 0.
LOOP AT lt_range_s INTO ls_range_s.
lv_column = lv_column + 1.
lv_fieldname = ls_range_s-fieldname.
"判断:是否存在日期格式与转换字段，如果存在则取转换字段值
READ TABLE lt_date_format INTO DATA(ls_date_format) WITH KEY fieldname = ls_range_s-fieldname BINARY SEARCH.
IF sy-subrc = 0.
SPLIT ls_date_format-date_format AT '&' INTO: lv_fieldname DATA(lv_sym).
ENDIF.
"转换字段1（用于区分0和空）
IF ls_range_s-fieldname_conv1 IS NOT INITIAL.
lv_fieldname = ls_range_s-fieldname_conv1.
ENDIF.
ASSIGN COMPONENT lv_fieldname OF STRUCTURE <ls_table> TO FIELD-SYMBOL(<lv_val>).
IF sy-subrc = 0.
ls_excel_input-row = lv_row.
ls_excel_input-column = lv_column.
ls_excel_input-value = <lv_val>.
CONDENSE ls_excel_input-value.
"负号提前
READ TABLE lt_flds INTO ls_flds WITH KEY fieldname = lv_fieldname
inttype = 'P'
BINARY SEARCH.
IF sy-subrc = 0.
CALL FUNCTION 'CLOI_PUT_SIGN_IN_FRONT'
CHANGING
value = ls_excel_input-value.
ENDIF.
APPEND ls_excel_input TO gt_excel_input.
CLEAR ls_excel_input.
ENDIF.
ENDLOOP.
ENDLOOP.
FREE <dny_tab_temp>.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form FRM_DOI_FILL_RANGES
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_GI_SPREADSHEET text
* -->P_GT_RANGES text
* -->P_GT_EXCEL_INPUT text
*----------------------------------------------------------------------*
FORM frm_doi_fill_ranges USING io_spreadsheet TYPE REF TO i_oi_spreadsheet
it_ranges TYPE soi_range_list
it_tab TYPE soi_generic_table.
DATA cl_errors TYPE REF TO i_oi_error OCCURS 0 WITH HEADER LINE.
CALL METHOD io_spreadsheet->set_ranges_data
EXPORTING
ranges = it_ranges
contents = it_tab
no_flush = 'X'
IMPORTING
error = cl_errors.
ENDFORM.
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM frm_hide_row_columns USING VALUE(p_sheetname) TYPE soi_field_name.
CASE p_sheetname.
WHEN cns_sheetname1_1
OR cns_sheetname1_2
OR cns_sheetname2_1
OR cns_sheetname2_2
OR cns_sheetname3_1
OR cns_sheetname3_2
OR cns_sheetname3_3
OR cns_sheetname4_1
OR cns_sheetname4_2
OR cns_sheetname5_1.
PERFORM frm_hide_columns USING 'A'.
PERFORM frm_hide_columns USING 'B'.
PERFORM frm_hide_columns USING 'C'.
PERFORM frm_hide_columns USING 'D'.
PERFORM frm_hide_columns USING 'E'.
PERFORM frm_hide_rows USING '1'.
ENDCASE.
ENDFORM.
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM frm_hide_columns USING iv_cell.
CALL METHOD gi_document->execute_macro
EXPORTING
macro_string = '模块1.HideColumns'
no_flush = 'X'
param_count = 1
param1 = iv_cell
IMPORTING
error = gi_error.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form FRM_HIDE_COLUMNS
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM frm_hide_rows USING iv_row.
CALL METHOD gi_document->execute_macro
EXPORTING
macro_string = '模块1.HideRows'
no_flush = 'X'
param_count = 1
param1 = iv_row
IMPORTING
error = gi_error.
ENDFORM.
*&--------
*----------------------------------------------------------------------*
FORM frm_default_selection USING pv_sheet_name.
DATA lv_column_str TYPE zexcel_cell_column_alpha.
DATA lv_str TYPE string.
DATA lv_row TYPE i.
READ TABLE gt_ztfi1249_b06 INTO DATA(gs_b06) WITH KEY sheet_name = pv_sheet_name fieldname = 'HCODE'.
READ TABLE gt_ztfi1249_b07 INTO DATA(gs_b07) WITH KEY sheet_name = pv_sheet_name BINARY SEARCH.
lv_row = gs_b07-start_row - 1.
IF lv_row <= 0.
RETURN.
ENDIF.
lv_column_str = zcl_excel_common=>convert_column2alpha( gs_b06-column_excel ). "数字转换字母
lv_str = | { lv_column_str }{ lv_row }|. "第几列 第几行 如A1
CONDENSE lv_str NO-GAPS.
"默认光标选中列
CALL METHOD gi_document->execute_macro
EXPORTING
macro_string = '模块1.SelectCell'
no_flush = 'X'
param_count = 1
param1 = lv_str
IMPORTING
error = gi_error.
* CALL METHOD gi_spreadsheet->set_selection
* EXPORTING
* left = 6 "从第几列开始
* top = 3 "从第几行开始
* rows = 1 "结束行
* columns = 1 "列数
* no_flush = 'X'.
ENDFORM.
method CONVERT_COLUMN2ALPHA.
DATA: lv_uccpi TYPE i,
lv_text TYPE sychar02,
lv_module TYPE int4,
lv_column TYPE zexcel_cell_column.
* Propagate zcx_excel if error occurs " issue #155 - less restrictive typing for ip_column
lv_column = convert_column2int( ip_column ). " issue #155 - less restrictive typing for ip_column
*--------------------------------------------------------------------*
* Check whether column is in allowed range for EXCEL to handle ( 1-16384 )
*--------------------------------------------------------------------*
IF lv_column > 16384
OR lv_column < 1.
RAISE EXCEPTION TYPE zcx_excel
EXPORTING
error = 'Index out of bounds'.
ENDIF.
*--------------------------------------------------------------------*
* Build alpha representation of column
*--------------------------------------------------------------------*
WHILE lv_column GT 0.
lv_module = ( lv_column - 1 ) MOD 26.
lv_uccpi = 65 + lv_module.
lv_column = ( lv_column - lv_module ) / 26.
lv_text = cl_abap_conv_in_ce=>uccpi( lv_uccpi ).
CONCATENATE lv_text ep_column INTO ep_column.
ENDWHILE.
endmethod.
*----------------------------------------------------------------------*
*&---------------------------------------------------------------------*
*& Form FRM_SET_CALCULATION
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_0033 text
*----------------------------------------------------------------------*
FORM frm_set_calculation USING iv_flag.
CALL METHOD gi_document->execute_macro
EXPORTING
macro_string = '模块1.set_calculation'
no_flush = 'X'
param_count = 1
param1 = iv_flag
IMPORTING
error = gi_error.
ENDFORM.
Sub Copy_Line(start_range As String, end_range As String)
If end_range <> start_range Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range(start_range).Select
Selection.AutoFill Destination:=Range(end_range)
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub
Sub set_calculation(flag As String)
If flag = "False" Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Else
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub
'选择Sheet页签
Sub SelectSheet(SheetName As String)
Sheets(SheetName).Select
End Sub
'选中单元格
Sub SelectCell(cell As String)
Dim Str As String
Str = cell & ":" & cell
Range(Str).Select
End Sub
'隐藏列
Sub HideColumns(cell As String)
Dim Str As String
Str = cell & ":" & cell
Columns(Str).Select
Selection.EntireColumn.Hidden = True
End Sub
'隐藏行
Sub HideRows(row As String)
Dim Str As String
Str = row & ":" & row
Rows(Str).Select
Selection.EntireRow.Hidden = True
End Sub
'测试宏
Sub test()
Call setcolor(1, 1, 1, 1, 217, 217, 217)
End Sub
'隐藏
Sub hidemenu()
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
Application.ScreenUpdating = True
End Sub
'显示
Sub showmenu()
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
Application.ScreenUpdating = True
End Sub
'设置区域属性
Sub setcolor(StartRow As Long, endRow As Long, StartCol As Long, EndCol As Long, R As Long, G As Long, B As Long)
Range(Cells(StartRow, StartCol), Cells(endRow, EndCol)).Select
Selection.Interior.Color = RGB(R, G, B)
End Sub
'隐藏sheet
Sub HideSheet(SheetName As String)
Sheets(SheetName).Visible = False
End Sub
'显示Sheet
Sub DisplaySheet(SheetName As String)
Sheets(SheetName).Visible = True
End Sub
'设置超链接
Sub SetHyper(cell As String, SubAddress As String)
Range(cell).Select
Selection.Hyperlinks(1).SubAddress = SubAddress
End Sub
'单元格赋值
Sub SetCellValue01(cell As String, Value As String)
Range(cell).Select
ActiveCell.FormulaR1C1 = Value
End Sub
'单元格赋值(公式不会转换为字符串)
Sub SetCellValue02(row As Long, Col As Long, Value As String)
Cells(row, Col) = Value
End Sub
'复制并插入一行
Sub Copy_Row(row As Integer)
Rows(row).Select
Selection.Copy
Selection.Insert Shift:=xlDown
End Sub
'复制并插入一行
Sub Copy_Row_1(row_c As Integer, row_i As Integer)
Dim Str_c As String
Dim Str_i As String
Str_c = row_c & ":" & row_c
Str_i = row_i & ":" & row_i
Rows(row_c).Select
Selection.Copy
Rows(row_i).Select
Selection.Insert Shift:=xlDown
End Sub
'插入一行
Sub Insert_Row(row As Integer)
Dim Str As String
Str = row & ":" & row
Rows(Str).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
'复制并插入列
Sub Copy_column(Col As String)
Dim Str As String
Str = Col & ":" & Col
Range(Str).Copy
Range(Str).Insert Shift:=xlShiftToRight
End Sub
'删除一行
Sub Del_Line(row As Integer)
Rows(row).Select
Selection.Delete Shift:=xlUp
End Sub
'清空区域数据
Sub Clear_Area(Area As String)
Range(Area).Select
Selection.ClearContents
Range("A1").Select
End Sub
'保护工作簿
Sub Protect_WorkBook(Locked As String)
Dim icnt As Long
Dim i As Long
icnt = Worksheets.Count
For i = 1 To icnt
Sheets(i).Cells.Locked = Locked
Next i
End Sub
'保护区域
Sub Protect_Range(StartRow As Long, endRow As Long, StartCol As Long, EndCol As Long, Locked As String)
Range(Cells(StartRow, StartCol), Cells(endRow, EndCol)).Select
Selection.Locked = Locked
Range("A1").Select
End Sub
'保护区域2
Sub Protect_Range2(cell As String, Locked As String)
Range(cell).Select
Selection.Locked = Locked
Range("A1").Select
End Sub
'添加备注
Sub Addcomment(row As Integer, Col As Integer, commtitle As String, commcontent As String)
Range(Cells(row, Col), Cells(row, Col)).Select
With Selection
.Addcomment
.Comment.Visible = False
.Comment.Text Text:=commtitle & Chr(10) & commcontent
End With
End Sub
'修改备注
Sub Modcomment(row As Integer, Col As Integer, commtitle As String, commcontent As String)
Range(Cells(row, Col), Cells(row, Col)).Select
With Selection
.Comment.Text Text:=commtitle & Chr(10) & commcontent
End With
End Sub
'删除备注
Sub Delcomment(row As Integer, Col As Integer)
Range(Cells(row, Col), Cells(row, Col)).Select
With Selection
.ClearComments
End With
End Sub
'合并单元格
Sub MergeCell(StartRow As Integer, StartCol As Integer, endRow As Integer, EndCol As Integer)
Range(Cells(StartRow, StartCol), Cells(endRow, EndCol)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
End Sub
'ENTER操作
Sub Enter()
Selection.Offset(1, 0).Select
End Sub
'保存操作
Sub Save()
ActiveWorkbook.Save
End Sub
'超链接
Sub hyperlink(Value As String, Url As String)
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Url, TextToDisplay:=Value
End Sub
'刷新透视表
Sub refresh_pivot(Count As Integer)
Dim i As Long
ActiveSheet.Unprotect Password:="VK1234"
For i = 1 To Count
ActiveSheet.PivotTables(i).PivotCache.Refresh
Next i
End Sub
'设置日期格式
Sub ref_date(cols As String)
Columns(cols).Select
Selection.NumberFormatLocal = "yyyy/m/d"
End Sub
'获取活动工作表的行数
Sub GetRowCount(SheetName As String, ByRef ret_value As String)
Set ws = ThisWorkbook.Sheets(SheetName)
ret_value = ws.UsedRange.Rows.Count
End Sub
'将公式转为值
Sub valtoval()
'转换之前备份
Filename = ActiveWorkbook.Name
'获取当前工作簿后缀的名称
hname = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStr(ThisWorkbook.Name, "."))
If hname = "xlsm" Then
pth = ThisWorkbook.Path & "\" & Replace(Filename, ".xlsm", "_转换.xlsm")
ActiveWorkbook.SaveAs Filename:=pth, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
If hname = "xlsb" Then
pth = ThisWorkbook.Path & "\" & Replace(Filename, ".xlsb", "_转换.xlsb")
ActiveWorkbook.SaveAs Filename:=pth, FileFormat:=xlExcel12, CreateBackup:=False
End If
'转换公式
For Each sh In Sheets
sh.AutoFilterMode = False
sh.UsedRange.Value = sh.UsedRange.Value
Next
MsgBox "ok"
End Sub
'在选中行下插入空行且复制公式
Sub InsertRowCopyContentAndDeleteNonFormula()
Dim activeSheetName As String
Dim selectedRow As Long
Dim lastColumn As Long
Dim formulaRange As Range
Dim cell As Range
Dim searchValue As String
Dim foundCell As Range
Dim row As String
' 设置要搜索的值
searchValue = "合计"
' 在整个工作表范围内搜索包含指定值的单元格
Set foundCell = Cells.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundCell Is Nothing Then
row = foundCell.row - 2
End If
' 获取当前活动页签的名称
activeSheetName = ActiveSheet.Name
' 获取当前选中行的行号
selectedRow = Selection.row
' 检查选中行是否小于第5行
If activeSheetName = "1.1" Or activeSheetName = "1.2" Or activeSheetName = "2.1" Or activeSheetName = "2.2" Or activeSheetName = "3.1" Or activeSheetName = "3.2" Or activeSheetName = "3.3" Or activeSheetName = "4.1" Or activeSheetName = "4.2" Or activeSheetName = "5.1" Then
If selectedRow < 5 Or selectedRow > row Then
MsgBox "请将光标放在第5行（含）和第" & row & "行（含）之间内再插入！", vbExclamation
Exit Sub
End If
End If
' 检查页签5.2、6.1、7.1、7.2选中行是否小于第4行
If activeSheetName = "5.2" Or activeSheetName = "6.1" Or activeSheetName = "7.1" Or activeSheetName = "7.2" Then
If selectedRow < 4 Or selectedRow > row Then
MsgBox "请将光标放在第4行（含）和第" & row & "行（含）之间内再插入！", vbExclamation
Exit Sub
End If
End If
' 检查页签5.3选中行是否小于第3行
If activeSheetName = "5.3" Then
If selectedRow < 3 Or selectedRow > row Then
MsgBox "请将光标放在第3行（含）和第" & row & "行（含）之间内再插入！", vbExclamation
Exit Sub
End If
End If
' 检查页签8.1、8.2选中行是否小于第3行
If activeSheetName = "8.1" Or activeSheetName = "8.2" Then
If selectedRow < 3 Then
MsgBox "请将光标放在第3行（含）之后再插入！", vbExclamation
Exit Sub
End If
End If
' 获取当前选中行的最后一列列号
lastColumn = Cells(selectedRow, Columns.Count).End(xlToLeft).Column
' 将选中行下方插入一行
Rows(selectedRow + 1).Insert Shift:=xlDown
' 复制选中行的内容
Range(Cells(selectedRow, 1), Cells(selectedRow, lastColumn)).Copy Destination:=Cells(selectedRow + 1, 1)
' 删除插入行单元格中没有公式的内容（除了A到E列）
For Each cell In Range(Cells(selectedRow + 1, 1), Cells(selectedRow + 1, lastColumn))
If activeSheetName = "1.1" Or activeSheetName = "1.2" Or activeSheetName = "2.1" Or activeSheetName = "2.2" Or activeSheetName = "3.1" Or activeSheetName = "3.2" Or activeSheetName = "3.3" Or activeSheetName = "4.1" Or activeSheetName = "4.2" Or activeSheetName = "5.1" Then
If cell.Column < 1 Or cell.Column > 5 Then
If Left(cell.Formula, 1) <> "=" Then
cell.ClearContents
End If
End If
End If
If activeSheetName = "5.2" Or activeSheetName = "5.3" Or activeSheetName = "6.1" Or activeSheetName = "7.1" Or activeSheetName = "7.2" Or activeSheetName = "8.1" Or activeSheetName = "8.2" Then
If Left(cell.Formula, 1) <> "=" Then
cell.ClearContents
End If
End If
Next cell
End Sub
'删除选中行
Sub DeleteSelectedRowsWithConfirmation()
Dim activeSheetName As String
Dim selectedRow As Long
Dim foundCell As Range
Dim row As String
Dim response As VbMsgBoxResult
Dim searchValue As String
' 设置要搜索的值
searchValue = "合计"
' 在整个工作表范围内搜索包含指定值的单元格
Set foundCell = Cells.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundCell Is Nothing Then
row = foundCell.row - 2
End If
' 获取当前活动页签的名称
activeSheetName = ActiveSheet.Name
' 获取当前选中行的行号
selectedRow = Selection.row
' 检查选中行是否小于第5行
If activeSheetName = "1.1" Or activeSheetName = "1.2" Or activeSheetName = "2.1" Or activeSheetName = "2.2" Or activeSheetName = "3.1" Or activeSheetName = "3.2" Or activeSheetName = "3.3" Or activeSheetName = "4.1" Or activeSheetName = "4.2" Or activeSheetName = "5.1" Then
If selectedRow < 5 Or selectedRow > row Then
MsgBox "只允许删除第5行（含）和第" & row & "行（含）之间的行！", vbExclamation
Exit Sub
End If
End If
' 检查页签5.2、6.1、7.1、7.2选中行是否小于第4行
If activeSheetName = "5.2" Or activeSheetName = "6.1" Or activeSheetName = "7.1" Or activeSheetName = "7.2" Then
If selectedRow < 4 Or selectedRow > row Then
MsgBox "只允许删除第4行（含）和第" & row & "行（含）之间行！", vbExclamation
Exit Sub
End If
End If
' 检查页签5.3选中行是否小于第3行
If activeSheetName = "5.3" Then
If selectedRow < 3 Or selectedRow > row Then
MsgBox "只允许删除第3行（含）和第" & row & "行（含）之间行！", vbExclamation
Exit Sub
End If
End If
' 检查页签8.1、8.2选中行是否小于第3行
If activeSheetName = "8.1" Or activeSheetName = "8.2" Then
If selectedRow < 3 Then
MsgBox "只允许删除第3行（含）之后行！", vbExclamation
Exit Sub
End If
End If
' 提示用户是否需要删除选中的行
response = MsgBox("确定要删除选中的行吗？", vbQuestion + vbYesNo, "确认删除")
' 检查用户的回答
If response = vbYes Then
On Error Resume Next
Selection.EntireRow.Delete
On Error GoTo 0
End If
End Sub