单据格式定义.frm

财务信息管理系统,适合做毕业论文的人使用

    Me.objF1Book.width = Me.picContainer.width - 60
    Me.objF1Book.Height = Me.picContainer.Height - 60
    ResizeCtbTool Me, picContainer, treStyle, jkrTree
    On Error GoTo 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmMain.mnuFormat.Visible = False
End Sub

Private Sub jkrTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Me.jkrTree.ZOrder 0
End Sub

Private Sub jkrTree_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Me.jkrTree.left < g_conMoveLimit Then
        Me.jkrTree.left = g_conMoveLimit
    ElseIf Me.jkrTree.left > Me.ScaleWidth - g_conMoveLimit Then
        Me.jkrTree.left = Me.ScaleWidth - g_conMoveLimit
    End If
    
    Me.treStyle.width = Me.jkrTree.left
    Me.picContainer.left = Me.jkrTree.left + 50
    Me.picContainer.width = Me.ScaleWidth - Me.treStyle.width - 50
    Me.objF1Book.width = Me.picContainer.width - 60
End Sub

Public Sub mnuColWidth_Click()
    objF1Book.SetSelection lDownRow, lDownCol, lUpRow, lUpCol
    frmRowHColW.Status = 1
    frmRowHColW.Show vbModal
End Sub

Public Sub mnuCut_Click()
    Me.objF1Book.EditCut
End Sub

Public Sub mnuDeleteCol_Click()
    Dim iDelete As Integer, i As Long
    Dim oFO As U8FDEso.FieldObject
    
    iDelete = 0
    If lDownCol > objF1Book.MaxCol Then lDownCol = objF1Book.MaxCol
    
    For i = 1 To objF1Book.MaxRow
    '    If Not FieldObjectRC(i, lDownCol) Is Nothing Then
    '        If FieldObjectRC(i, lDownCol).FieldOption = esoMustBeSelected Then
    '            iDelete = 1
    '            Exit For
    '        End If
    '    End If
    
        If Not FieldObjectRC(i, lDownCol) Is Nothing Then
            If FieldObjectRC(i, lDownCol).StartCol = lDownCol And FieldObjectRC(i, lDownCol).DataType <> U8FDEso.esoLabel Then
                iDelete = 1
                Exit For
            End If
            If Len(objF1Book.FormattedTextRC(i, lDownCol)) <> 0 And FieldObjectRC(i, lDownCol).EndCol - FieldObjectRC(i, lDownCol).StartCol = 1 Then
                iDelete = 1
                Exit For
            End If
        End If
    Next
    If iDelete = 1 Then
        MsgBox "内有项目或数据，不能删除！", vbInformation, App.ProductName
    Else
        For i = 1 To objF1Book.MaxRow
            MergeCell = False
            If Not FieldObjectRC(i, lDownCol) Is Nothing Then
                With FieldObjectRC(i, lDownCol)
                    objF1Book.SetSelection i, lDownCol, i, lDownCol + 1
                    Set CellFormat = objF1Book.GetCellFormat
                    If CellFormat.MergeCells Then
                        CellFormat.MergeCells = False
                        objF1Book.SetCellFormat CellFormat
                        MergeCell = True
                    End If
                    objF1Book.MoveRange i, lDownCol + 1, i, objF1Book.MaxCol, 0, -1
                    objF1Book.ClearRange i, objF1Book.MaxCol, i, objF1Book.MaxCol, F1ClearAll
                    
                    If .InputCol <> 0 And .InputCol > .StartCol + 1 Then .InputCol = .InputCol - 1
                    .EndCol = .EndCol - 1
                    
                    If MergeCell Then
                        If .DataType <> U8FDEso.esoLabel Then objF1Book.SetSelection .Row, .StartCol + 1, .Row, .EndCol
                        If .DataType = U8FDEso.esoLabel Then objF1Book.SetSelection .Row, .StartCol, .Row, .EndCol
                        Set CellFormat = objF1Book.GetCellFormat
                        CellFormat.MergeCells = True
                        objF1Book.SetCellFormat CellFormat
                    Else '理由同增加一列
                        If .DataType <> U8FDEso.esoLabel Then objF1Book.SetSelection .Row, .StartCol + 1, .Row, .EndCol
                        If .DataType = U8FDEso.esoLabel Then objF1Book.SetSelection .Row, .StartCol, .Row, .EndCol
                        Set CellFormat = objF1Book.GetCellFormat
                        CellFormat.MergeCells = True
                        objF1Book.SetCellFormat CellFormat
                    End If
                    If .DataType <> U8FDEso.esoLabel Then
                        objF1Book.TextRC(.Row, .StartCol + 1) = "[数据]"
                    Else
                        objF1Book.TextRC(.Row, .StartCol) = .Caption
                    End If
                End With
            Else
                objF1Book.SetSelection i, lDownCol, i, lDownCol
                Set CellFormat = objF1Book.GetCellFormat
                If CellFormat.MergeCells Then
                    CellFormat.MergeCells = False
                    objF1Book.SetCellFormat CellFormat
                End If
                
                If lDownCol = objF1Book.MaxCol Then
                    objF1Book.ClearRange i, lDownCol, i, objF1Book.MaxCol, F1ClearAll
                Else
                    objF1Book.MoveRange i, lDownCol + 1, i, objF1Book.MaxCol, 0, -1
                    objF1Book.ClearRange i, objF1Book.MaxCol, i, objF1Book.MaxCol, F1ClearAll
                End If
            End If
        Next
        
'        For Each oFO In m_EO.Fields
        For i = 1 To m_EO.Fields.count
            Set oFO = m_EO.Fields.Item(i)
            With oFO
                If .StartCol > lDownCol Then
                    .StartCol = .StartCol - 1
                    If .InputCol <> 0 And .InputCol - .StartCol > 1 Then .InputCol = .InputCol - 1
                    .EndCol = .EndCol - 1
                End If
            End With
        Next
        
        m_EO.Cols = m_EO.Cols - 1
        objF1Book.MaxCol = objF1Book.MaxCol - 1
    End If
End Sub

Public Sub mnuDeleteRow_Click()
    Dim iDelete As Integer, i As Long
    Dim oFO As U8FDEso.FieldObject
    
    If lDownRow > objF1Book.MaxRow Then lDownRow = objF1Book.MaxRow
    iDelete = 1
    For i = 1 To objF1Book.MaxCol
'        If Not FieldObjectRC(lDownRow, i) Is Nothing Then
'            If FieldObjectRC(lDownRow, i).FieldOption = esoMustBeSelected Then
'                iDelete = 0
'                Exit For
'            End If
'        End If
        If Len(objF1Book.FormattedTextRC(lDownRow, i)) <> 0 Then
            iDelete = 0
            Exit For
        End If
    Next
    
    If iDelete = 0 Then
        MsgBox "有项目，不能删除!", vbInformation, App.ProductName
    Else
        objF1Book.DeleteRange lDownRow, 1, lDownRow, objF1Book.MaxCol, F1ShiftRows
'        For Each oFO In m_EO.Fields
        For i = 1 To m_EO.Fields.count
            Set oFO = m_EO.Fields.Item(i)
            With oFO
                If .Row > lDownRow Then '不可能等于
                    oFO.Row = oFO.Row - 1
                End If
            End With
        Next
        m_EO.Rows = m_EO.Rows - 1
        objF1Book.MaxRow = objF1Book.MaxRow - 1
    End If
End Sub

Public Sub mnuInsertCol_Click()
    Dim i   As Long
    Dim oFO As U8FDEso.FieldObject
    
    If lDownCol > objF1Book.MaxCol Then lDownCol = objF1Book.MaxCol
'    For Each oFO In m_EO.Fields
    For i = 1 To m_EO.Fields.count
        Set oFO = m_EO.Fields.Item(i)
        With oFO
            If .StartCol >= lDownCol Then
                .StartCol = .StartCol + 1
                If .InputCol <> 0 Then .InputCol = .InputCol + 1
                .EndCol = .EndCol + 1
            ElseIf .StartCol < lDownCol And .EndCol >= lDownCol Then
                If .InputCol <> 0 Then .InputCol = .InputCol + 1
                .EndCol = .EndCol + 1
            End If
        End With
    Next
    m_EO.Cols = m_EO.Cols + 1
    objF1Book.MaxCol = objF1Book.MaxCol + 1
    For i = 1 To objF1Book.MaxRow
        MergeCell = False
        If lDownCol <> 1 And Not FieldObjectRC(i, lDownCol - 1, lDownCol) Is Nothing Then
            objF1Book.SetSelection i, lDownCol - 1, i, lDownCol
            Set CellFormat = objF1Book.GetCellFormat
            If CellFormat.MergeCells Then
                CellFormat.MergeCells = False
                objF1Book.SetCellFormat CellFormat
                MergeCell = True
            End If
            objF1Book.MoveRange i, lDownCol, i, objF1Book.MaxCol - 1, 0, 1
            
            objF1Book.SetActiveCell i, lDownCol + 1
            Set CellFormat = objF1Book.GetCellFormat
            objF1Book.SetActiveCell i, lDownCol
            objF1Book.SetCellFormat CellFormat
            
            With FieldObjectRC(i, lDownCol)
                If MergeCell Then
                    If .DataType <> U8FDEso.esoLabel Then objF1Book.SetSelection .Row, .StartCol + 1, .Row, .EndCol
                    If .DataType = U8FDEso.esoLabel Then objF1Book.SetSelection .Row, .StartCol, .Row, .EndCol
                    Set CellFormat = objF1Book.GetCellFormat
                    CellFormat.MergeCells = True
                    objF1Book.SetCellFormat CellFormat
                    If .DataType <> U8FDEso.esoLabel Then objF1Book.TextRC(.Row, .StartCol + 1) = "[数据]"
                Else
                    '保持原来风格
                    If .DataType <> U8FDEso.esoLabel Then objF1Book.SetSelection .Row, .StartCol + 1, .Row, .EndCol
                    If .DataType = U8FDEso.esoLabel Then objF1Book.SetSelection .Row, .StartCol, .Row, .EndCol
                    Set CellFormat = objF1Book.GetCellFormat
                    CellFormat.MergeCells = True
                    objF1Book.SetCellFormat CellFormat
                    If .DataType <> U8FDEso.esoLabel Then objF1Book.TextRC(.Row, .StartCol + 1) = "[数据]" '如果不合并,删除此行
                End If
                
            End With
        Else
            If lDownCol <> 1 Then
                objF1Book.SetSelection i, lDownCol - 1, i, lDownCol
                Set CellFormat = objF1Book.GetCellFormat
                If CellFormat.MergeCells Then
                    CellFormat.MergeCells = False
                    objF1Book.SetCellFormat CellFormat
                End If
            End If
            
            objF1Book.MoveRange i, lDownCol, i, objF1Book.MaxCol - 1, 0, 1
            objF1Book.SetActiveCell i, lDownCol + 1
            Set CellFormat = objF1Book.GetCellFormat
            objF1Book.SetActiveCell i, lDownCol
            objF1Book.SetCellFormat CellFormat
        End If
    Next
End Sub

Public Sub mnuInsertRow_Click()
    Dim oFO As U8FDEso.FieldObject
    Dim i   As Integer
    
    If lDownRow > objF1Book.MaxRow Then lDownRow = objF1Book.MaxRow
    objF1Book.InsertRange lDownRow, lDownCol, lDownRow, lDownCol + objF1Book.MaxCol, F1ShiftRows
'    For Each oFO In m_EO.Fields
    For i = 1 To m_EO.Fields.count
        Set oFO = m_EO.Fields.Item(i)
        With oFO
            If .Row >= lDownRow Then
                oFO.Row = oFO.Row + 1
            End If
        End With
    Next
    m_EO.Rows = m_EO.Rows + 1
    objF1Book.MaxRow = objF1Book.MaxRow + 1
End Sub

Public Sub mnuItemAdd_Click()
    frmVchItem.AddOrEdit = 2
    frmVchItem.Caption = frmVchItem.Caption & "增加项目"
    frmVchItem.Show vbModal
End Sub

Public Sub mnuItemDelete_Click()
    Dim iTemp As Integer, i As Long, j As Long
    
    If lDownCol > lUpCol Then
        iTemp = lDownCol
        lDownCol = lUpCol
        lUpCol = iTemp
    End If
    If lDownRow > lUpRow Then
        iTemp = lDownRow
        lDownRow = lUpRow
        lUpRow = iTemp
    End If
    If lDownRow * lUpRow * lDownCol * lUpCol = 0 Then
        If Not FieldObjectRC(lDownRow, lDownCol) Is Nothing Then
            With FieldObjectRC(lDownRow, lDownCol)
                If Not .IsUsed Then
                    objF1Book.SetSelection lDownRow, lDownCol, lDownRow, lDownCol
                    Set CellFormat = objF1Book.GetCellFormat
                    If Not CellFormat.MergeCells Then
                        objF1Book.ClearRange lDownRow, lDownCol, lDownRow, lDownCol, F1ClearAll '.Row, .StartCol, .Row, .EndCol, F1ClearAll
                    End If
                End If
            End With
        End If
    Else
        For i = lDownRow To lUpRow
            For j = lDownCol To lUpCol
                If Not FieldObjectRC(i, j) Is Nothing Then
                    With FieldObjectRC(i, j)
                        If .FieldOption <> U8FDEso.esoMustBeSelected Then
                            objF1Book.SetSelection i, j, i, j
                            Set CellFormat = objF1Book.GetCellFormat
                            If Not CellFormat.MergeCells Then
                                objF1Book.ClearRange .Row, .StartCol, .Row, .EndCol, F1ClearAll 'i, j, i, j, F1ClearAll '
                            Else
                                objF1Book.ClearRange .Row, .StartCol, .Row, .EndCol, F1ClearAll 'i, j, i, j, F1ClearAll '
                            End If
                        End If
                    End With
                End If
            Next
            For j = lDownCol To lUpCol
                If Not FieldObjectRC(i, j) Is Nothing Then
                    With FieldObjectRC(i, j)
                        If .FieldOption <> U8FDEso.esoMustBeSelected Then
                            .IsUsed = False
                            .Row = 0
                            .StartCol = 0
                            .InputCol = 0
                            .EndCol = 0
                        End If
                    End With
                End If
            Next
        Next
    End If
End Sub

Public Sub mnuItemEdit_Click()
    frmVchItem.AddOrEdit = 1
    frmVchItem.Caption = frmVchItem.Caption & "修改项目"
    frmVchItem.Show vbModal
End Sub

Public Sub mnuCellSet_Click()
    If lDownRow * lDownCol * lUpRow * lUpCol = 0 Then
        MsgBox "没有选择设置区域", vbInformation, App.ProductName
        Exit Sub
    End If
    objF1Book.SetSelection lDownRow, lDownCol, lUpRow, lUpCol
    Set CellFormat = objF1Book.GetCellFormat