VB开发的ERP系统

      Begin VB.Menu m_unlock 
         Caption         =   "解除锁定"
      End
      Begin VB.Menu YCHB 
         Caption         =   "隐藏行标"
         Checked         =   -1  'True
      End
      Begin VB.Menu YCLB 
         Caption         =   "隐藏列标"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu m_biaoge 
      Caption         =   "表格(&T)"
      Begin VB.Menu m_cell 
         Caption         =   "单元格"
      End
      Begin VB.Menu m_size 
         Caption         =   "表尺寸"
      End
      Begin VB.Menu bgbj 
         Caption         =   "表格背景"
      End
      Begin VB.Menu m_fg12 
         Caption         =   "-"
      End
      Begin VB.Menu m_hide 
         Caption         =   "打印时隐藏"
      End
      Begin VB.Menu m_show 
         Caption         =   "取消隐藏"
      End
      Begin VB.Menu m_fg8 
         Caption         =   "-"
      End
      Begin VB.Menu m_insert_row 
         Caption         =   "插入行"
      End
      Begin VB.Menu m_insert_col 
         Caption         =   "插入列"
      End
      Begin VB.Menu m_del_row 
         Caption         =   "删除行"
      End
      Begin VB.Menu m_del_col 
         Caption         =   "删除列"
      End
      Begin VB.Menu m_fg9 
         Caption         =   "-"
      End
      Begin VB.Menu m_insert_picture 
         Caption         =   "插入图片"
      End
      Begin VB.Menu m_szzh 
         Caption         =   "设置组合"
      End
      Begin VB.Menu m_qxzh 
         Caption         =   "取消组合"
      End
      Begin VB.Menu m_same_height 
         Caption         =   "行等高"
      End
      Begin VB.Menu m_same_width 
         Caption         =   "列等宽"
      End
   End
   Begin VB.Menu m_page 
      Caption         =   "表页(&P)"
      Begin VB.Menu m_label 
         Caption         =   "设置页签"
      End
      Begin VB.Menu m_backcolor 
         Caption         =   "公式单元背景颜色"
      End
      Begin VB.Menu m_fg10 
         Caption         =   "-"
      End
      Begin VB.Menu m_insert_page 
         Caption         =   "插入表页"
      End
      Begin VB.Menu m_append_page 
         Caption         =   "追加表页"
      End
      Begin VB.Menu bbcopy 
         Caption         =   "拷贝表页"
      End
      Begin VB.Menu m_del_page 
         Caption         =   "删除表页"
      End
      Begin VB.Menu a1111 
         Caption         =   "-"
      End
      Begin VB.Menu bbhz 
         Caption         =   "报表汇总"
      End
   End
   Begin VB.Menu m_data 
      Caption         =   "数据(&D)"
      Begin VB.Menu m_set_formula 
         Caption         =   "公式设置"
      End
      Begin VB.Menu m_insert_formula 
         Caption         =   "输入公式"
      End
      Begin VB.Menu m_recompute 
         Caption         =   "公式重算"
         Begin VB.Menu m_compute_page 
            Caption         =   "本页重算"
         End
         Begin VB.Menu m_compute_all 
            Caption         =   "全部重算"
         End
      End
      Begin VB.Menu m_sjzz 
         Caption         =   "数据转置"
      End
      Begin VB.Menu m_graph_wizard 
         Caption         =   "图表向导"
      End
   End
   Begin VB.Menu m_manage 
      Caption         =   "管理(&M)"
      Begin VB.Menu m_module 
         Caption         =   "新建报表模版"
      End
      Begin VB.Menu m_modifymodule 
         Caption         =   "修改报表模版"
      End
      Begin VB.Menu m_model_manage 
         Caption         =   "报表模板管理"
      End
      Begin VB.Menu m_report_manage 
         Caption         =   "报表管理"
      End
   End
   Begin VB.Menu m_windows 
      Caption         =   "窗口(&W)"
      WindowList      =   -1  'True
      Begin VB.Menu m_Horizontal 
         Caption         =   "水平平铺"
      End
      Begin VB.Menu m_vertical 
         Caption         =   "垂直平铺"
      End
      Begin VB.Menu m_cascade 
         Caption         =   "层叠"
      End
      Begin VB.Menu m_icons 
         Caption         =   "排列图标"
      End
   End
   Begin VB.Menu m_help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnubz 
         Caption         =   "帮助主题"
         HelpContextID   =   10
      End
      Begin VB.Menu m_about 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "MDI_frame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************
'*    模 块 名 称 : 系统MDI窗体
'*    功 能 描 述 : 系统MDI窗体
'*    程序员姓名  : 奚俊峰
'*    最后修改人  : 奚俊峰
'*    最后修改时间: 2002/01/13
'******************************************************************


Option Explicit

'声明必要的 API 例程：
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim SONG_i As Integer, SONG_j As Integer

Public ml_new_lx As Long                             '新建类型
Public ml_open_lx As Long                            '打开类型
Public ms_txt_file As String                         '文本文件名称
Public ml_txt_format As Long                         '文本文件格式
Public lcls_xltc As cls_xltc                         '序列填充
Public mcls_new_report As cls_new_report             '新建报表类
Public mcls_new_report_model As cls_new_report_model '新建报表模板类
Public mcls_open_report As cls_open_report           '打开报表类
Public mcls_open_report_model As cls_open_report_model '打开报表模板类
Public mb_new_report As Boolean                      '是否新建报表
Public mb_new_report_model As Boolean                '是否新建报表模板
Public mb_open_report As Boolean                     '是否打开报表
Public mb_open_report_model As Boolean               '是否打开报表模板
Public ml_frmedit_count As Long                      '打开的编辑窗口数量
Public ml_new_file_count As Long                     '新建文件数量
Public mb_setfont As Boolean                         '是否设置字体，用以解决两个COMBO控件之间的冲突

Sub DetectExcel()
    '该过程检测并登记正在运行的 Excel。
    Const WM_USER = 1024
    Dim hwnd As Long
    '如果 Excel 在运行，则该 API 调用将返回其句柄。
    hwnd = FindWindow("XLMAIN", 0)
    If hwnd = 0 Then    '0 表示没有 Excel 在运行。
        Exit Sub
    Else
        'Excel 在运行，因此可以使用 SendMessage API
        '函数将其放入运行对象表。
        SendMessage hwnd, WM_USER + 18, 0, 0
    End If
End Sub

Sub GetExcel(ByVal OPENEXCEL_FILENAME As String)
    Dim MyXL As Object   '用于存放
    'Microsoft Excel 引用的变量。
    Dim ExcelWasNotRunning As Boolean   '用于最后释放的标记。
    
    '测试 Microsoft Excel 的副本是否在运行。
    On Error Resume Next   '延迟错误捕获。
    '不带第一个参数调用 Getobject 函数将
    '返回对该应用程序的实例的引用。
    '如果该应用程序不在运行，则会产生错误。
    Set MyXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then ExcelWasNotRunning = True
    Err.Clear   '如果发生错误则要清除 Err 对象。
    
    '检测 Microsoft Excel。如果 Microsoft Excel 在运行，
    '则将其加入运行对象表。
    DetectExcel
    
    '将对象变量设为对要看的文件的引用。
    Set MyXL = GetObject(OPENEXCEL_FILENAME)
     
    '设置其 Application 属性，显示 Microsoft Excel。
    '然后使用 MyXL 对象引用的 Windows 集合
    '显示包含该文件的实际窗口。
    ' MyXL.Application.Visible = True
    SONG_i = 1
    '将Excel 文件在没用的窗体中打开
    Do While SONG_i < 30
        If MyXL.parent.Windows(SONG_i).Visible = False Then
            MyXL.parent.Windows(SONG_i).Visible = True
            Exit Do
        Else
            SONG_i = SONG_i + 1
        End If
    Loop
    MyXL.Application.WindowState = 2
    MyXL.Application.Visible = False
    If SONG_i = 30 Then
        MsgBox "打开EXCEL 文件失败!!!" & vbCrLf & "Excel 打开文件太多!!!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
        Exit Sub
    End If
    MDI_frame.Caption = Left(MDI_frame.Caption, 20) & OPENEXCEL_FILENAME
    '在此处对文件
    '进行操作。
    Dim excelcolA(1 To 26) As Variant '定义阿A-Z 的储存数组
    '定义合并单元的位置
    Dim TEMP_STAROW As Integer, TEMP_STACOL As Integer, TEMP_ENDCOL As Integer, TEMP_ENDrow As Integer
    Dim k As Integer
    Dim tempmergearea As Variant '定义合并单元位置地址的字符串
    Dim excelsheetname As String
    For SONG_i = 65 To 90
        '得到A-Z的ASCII码
        excelcolA(SONG_i - 64) = Chr(SONG_i)
    Next SONG_i
    '重新设置CELL的行列
    excelsheetname = MyXL.worksheets(1).Name
    ActiveForm.Cell1.DoSetPageLabel = excelsheetname
    ActiveForm.Cell1.Cols = 0
    ActiveForm.Cell1.Rows = 0
    song_row = 20
    song_col = 15
    Dim ap
    For SONG_i = Len(OPENEXCEL_FILENAME) To 0 Step -1
        If Mid(OPENEXCEL_FILENAME, SONG_i, 1) = "\" Then
            ap = Right(OPENEXCEL_FILENAME, Len(OPENEXCEL_FILENAME) - SONG_i)
            Exit For
        End If
    Next SONG_i
    frm_rowcol.Label2.Caption = "您打开的文件为：" & ap
    frm_rowcol.Label2.AutoSize = True
    
    frm_rowcol.Show vbModal, MDI_frame
    
    ActiveForm.Cell1.Rows = song_row
    ActiveForm.Cell1.Cols = song_col
    
    
    For SONG_j = 1 To ActiveForm.Cell1.Rows
        ActiveForm.Cell1.DoSetRowHeight SONG_j - 1, MyXL.worksheets(excelsheetname).Rows(SONG_j).Height * 1.4
    Next SONG_j
    For SONG_i = 1 To ActiveForm.Cell1.Cols - 1
        ActiveForm.Cell1.DoSetColWidth SONG_i - 1, MyXL.worksheets(excelsheetname).Columns(SONG_i).Width * 1.4
    Next SONG_i
    '以下为读取Excel 文件并填充数据
    SONG_j = 1 '初始化行
    Do While SONG_j < ActiveForm.Cell1.Rows
        SONG_i = 1 '列
        If MyXL.worksheets(excelsheetname).range(excelcolA(SONG_i) & Trim(Str(SONG_j))).Borders(7).LineStyle = 1 Then
            ActiveForm.Cell1.DoDrawLine SONG_i - 1, SONG_j - 1, SONG_i - 1, SONG_j - 1, 2, 1, RGB(0, 0, 0) '边框
        End If
        Do While SONG_i < ActiveForm.Cell1.Cols
            Set tempmergearea = MyXL.worksheets(excelsheetname).range(excelcolA(SONG_i) & Trim(Str(SONG_j))).mergearea
            If tempmergearea.ADDRESS = "$" & excelcolA(SONG_i) & "$" & Trim(Str(SONG_j)) Then '不再合并组合中
                
                If MyXL.worksheets(excelsheetname).range(excelcolA(SONG_i) & Trim(Str(SONG_j))).Borders(8).LineS