⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmimport.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 4 页
字号:
        End If
    Next
    cmdOK_Click = True
EndProc:
    Me.MousePointer = vbDefault
End Function

Private Function PathValid() As Boolean
    Dim i As Long
    Dim j As Long
    Dim lngCount As Long
    
    For i = 1 To GrdCol.Rows - 1
        If GrdCol.TextMatrix(i, 1) <> "" Then
            lngCount = 1
            For j = i - 1 To 1 Step -1
                If GrdCol.RowHeight(j) <> 0 Then
                    If GrdCol.TextMatrix(j, 1) <> "" Then
                        If RowPropertys(GrdCol.RowData(i)).strPath = RowPropertys(GrdCol.RowData(j)).strPath Then
                            Exit For
                        End If
                    End If
                    lngCount = lngCount + 1
                End If
            Next
            If j = 0 Then
                If Dir(RowPropertys(GrdCol.RowData(i)).strPath, vbDirectory) = "" Then
                    cMsgBox "第" & lngCount & "行的路径不存在,请重新选择!", "数据导入"
                    Exit Function
                End If
            End If
        End If
    Next
    PathValid = True
End Function

Private Function ImportItems(ByVal lngRow As Long) As Boolean
    Dim i As Long
    Dim blnItems(100) As Boolean
    
    For i = lngRow To GrdCol.Rows - 1
        If GrdCol.TextMatrix(i, 1) <> "" Then
            If RowPropertys(GrdCol.RowData(i)).strPath = RowPropertys(GrdCol.RowData(lngRow)).strPath Then
                blnItems(ItemName2NO(RowPropertys(GrdCol.RowData(i)).strData(2))) = True
            End If
        End If
    Next
    AccountImport RowPropertys(GrdCol.RowData(lngRow)).strPath & "\format.ini", blnItems
End Function

Private Function ItemName2NO(ByVal strItemName As String) As Long
    Select Case strItemName
    Case "货币"
        ItemName2NO = 0
    Case "科目"
        ItemName2NO = 1
    Case "部门"
        ItemName2NO = 2
    Case "职员类别"
        ItemName2NO = 3
    Case "职员"
        ItemName2NO = 4
    Case "单位类别"
        ItemName2NO = 5
    Case "单位"
        ItemName2NO = 6
    Case "统计核算"
        ItemName2NO = 7
    Case "项目核算"
        ItemName2NO = 8
    Case "商品性质"
        ItemName2NO = 9
    Case "商品类别"
        ItemName2NO = 10
    Case "商品"
        ItemName2NO = 11
    Case "商品单位"
        ItemName2NO = 12
    Case "货位"
        ItemName2NO = 13
    Case "工程类别"
        ItemName2NO = 14
    Case "工程"
        ItemName2NO = 15
    Case "自定义项目0"
        ItemName2NO = 16
    Case "自定义项目1"
        ItemName2NO = 17
    Case "自定义项目2"
        ItemName2NO = 18
    Case "自定义项目3"
        ItemName2NO = 19
    Case "自定义项目4"
        ItemName2NO = 20
    Case "自定义项目5"
        ItemName2NO = 21
    Case "凭证类别"
        ItemName2NO = 22
    Case "单据模板"
        ItemName2NO = 23
    Case "固资方式"
        ItemName2NO = 24
    Case "固资类别"
        ItemName2NO = 25
    Case "企业收发地址"
        ItemName2NO = 26
    Case "企业开户银行"
        ItemName2NO = 27
    Case "单位收发地址"
        ItemName2NO = 28
    Case "单位开户银行"
        ItemName2NO = 29
    Case "凭证"
        ItemName2NO = 30
    Case "余额"
        ItemName2NO = 31
    Case "科目期初"
        ItemName2NO = 32
    Case "应收应付余额"
        ItemName2NO = 33
    Case "应收应付期初"
        ItemName2NO = 34
    Case "现金银行余额"
        ItemName2NO = 35
    Case "银行对帐单"
        ItemName2NO = 36
    Case "银行帐期初"
        ItemName2NO = 37
    Case "固资变动"
        ItemName2NO = 38
    Case "财务预算"
        ItemName2NO = 39
    Case "经营预算"
        ItemName2NO = 40
    Case "采购订单"
        ItemName2NO = 41
    Case "商品采购"
        ItemName2NO = 42
    Case "直运采购"
        ItemName2NO = 43
    Case "受托入库"
        ItemName2NO = 44
    Case "受托结算"
        ItemName2NO = 45
    Case "加工入库"
        ItemName2NO = 46
    Case "加工费用"
        ItemName2NO = 47
    Case "采购发票"
        ItemName2NO = 48
    Case "自制入库"
        ItemName2NO = 49
    Case "盘盈入库"
        ItemName2NO = 50
    Case "其他入库"
        ItemName2NO = 51
    Case "销售订单"
        ItemName2NO = 52
    Case "商品销售"
        ItemName2NO = 53
    Case "直运销售"
        ItemName2NO = 54
    Case "委托出库"
        ItemName2NO = 55
    Case "委托结算"
        ItemName2NO = 56
    Case "加工出库"
        ItemName2NO = 57
    Case "分期出库"
        ItemName2NO = 58
    Case "分期结算"
        ItemName2NO = 59
    Case "销售发票"
        ItemName2NO = 60
    Case "领用出库"
        ItemName2NO = 61
    Case "成本调整"
        ItemName2NO = 62
    Case "盘亏出库"
        ItemName2NO = 63
    Case "其他出库"
        ItemName2NO = 64
    Case "代销调拨"
        ItemName2NO = 66
    Case "商品调拨"
        ItemName2NO = 68
    Case "商品调价"
        ItemName2NO = 69
    Case "商品组装"
        ItemName2NO = 70
    Case "商品拆卸"
        ItemName2NO = 71
    Case "商品盘点"
        ItemName2NO = 73
    Case "应付贷项"
        ItemName2NO = 74
    Case "应付借项"
        ItemName2NO = 75
    Case "应收借项"
        ItemName2NO = 76
    Case "应收贷项"
        ItemName2NO = 77
    Case "应收计息"
        ItemName2NO = 78
    Case "付款单"
        ItemName2NO = 79
    Case "收款单"
        ItemName2NO = 80
    Case "库存期初"
        ItemName2NO = 82
    Case "受托期初"
        ItemName2NO = 83
    Case "委托期初"
        ItemName2NO = 84
    Case "分期期初"
        ItemName2NO = 85
    Case "直运期初"
        ItemName2NO = 86
    Case "加工期初"
        ItemName2NO = 87
    Case "暂估期初"
        ItemName2NO = 92
    Case "固资期初"
        ItemName2NO = 93
    Case "拜访客户资料"
        ItemName2NO = 94
    Case "现金项目"
        ItemName2NO = 95
    Case "地区"
        ItemName2NO = 96        
    End Select
End Function

Private Sub ShowAll()
    Dim i As Long
    Dim blnRedrawBak As Boolean
    
    blnRedrawBak = GrdCol.Redraw
    GrdCol.Redraw = False
    If chkShowALL.Value = 0 Then
        For i = 1 To GrdCol.Rows - 1
            If RowPropertys(GrdCol.RowData(i)).strData(9) <> "" Then
                SetSelectRow i, False
                GrdCol.RowHeight(i) = 0
            Else
                GrdCol.RowHeight(i) = 270
            End If
        Next
    Else
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.RowHeight(i) = 0 Then
                SetSelectRow i, False
                GrdCol.RowHeight(i) = 270
            End If
        Next
    End If
    For i = 1 To GrdCol.Rows - 1
        If GrdCol.RowHeight(i) <> 0 Then
            GrdCol.Row = i
            Exit For
        End If
    Next
    SetButtonEnabled
    GrdCol.Redraw = blnRedrawBak
End Sub

Private Sub SetButtonEnabled()
    Dim i As Long
    Dim blnButtonEnabled(6) As Boolean
    
    With GrdCol
        blnButtonEnabled(3) = True
        blnButtonEnabled(4) = True
        blnButtonEnabled(5) = True
        blnButtonEnabled(6) = True
    
        If .Rows = 1 Then
            blnButtonEnabled(3) = False
            blnButtonEnabled(4) = False
            blnButtonEnabled(5) = False
            blnButtonEnabled(6) = False
            GoTo EndProc
        End If
        If .Rows = 2 Then
            If .RowHeight(1) = 0 Then
                blnButtonEnabled(3) = False
                blnButtonEnabled(4) = False
            End If
            blnButtonEnabled(5) = False
            blnButtonEnabled(6) = False
            GoTo EndProc
        End If
        If .Row = 1 Then
            blnButtonEnabled(5) = False
        End If
        If .Row = .Rows - 1 Then
            blnButtonEnabled(6) = False
        End If
        If chkShowALL.Value = 0 Then
            blnButtonEnabled(3) = False
            blnButtonEnabled(4) = False
            For i = 1 To .Row - 1
                If .RowHeight(i) <> 0 Then
                    blnButtonEnabled(3) = True
                    blnButtonEnabled(4) = True
                    Exit For
                End If
            Next
            If i = .Row Then
                blnButtonEnabled(5) = False
            End If
            For i = .Row + 1 To .Rows - 1
                If .RowHeight(i) <> 0 Then
                    blnButtonEnabled(3) = True
                    blnButtonEnabled(4) = True
                    Exit For
                End If
            Next
            If i = .Rows Then
                blnButtonEnabled(6) = False
            End If
            If .RowHeight(.Row) > 0 Then
                blnButtonEnabled(5) = True
                blnButtonEnabled(6) = True
            End If
        End If
    End With
EndProc:
    cmdOkCancel(3).Enabled = blnButtonEnabled(3)
    cmdOkCancel(4).Enabled = blnButtonEnabled(4)
'    cmdOkCancel(5).Enabled = blnButtonEnabled(5)
'    cmdOkCancel(6).Enabled = blnButtonEnabled(6)
    Erase blnButtonEnabled
End Sub

Private Sub GrdCol_RowColChange()
'    SetButtonEnabled
End Sub

Private Sub RowExchange(Optional ByVal blnUp As Boolean = True)
    Dim i As Long, lngRowDes As Long
    Dim strDataTmp As String
    
    With GrdCol
        
        For i = 1 To .Cols - 1
            .TextMatrix(0, i) = ColName(i)
        Next
        
        If blnUp Then
            For i = .Row - 1 To 1
                If .RowHeight(i) <> 0 Then
                    Exit For
                End If
            Next
            If i <> 0 Then
                lngRowDes = i
            End If
        Else
            For i = .Row + 1 To .Rows - 1
                If .RowHeight(i) <> 0 Then
                    Exit For
                End If
            Next
            If i <> .Rows Then
                lngRowDes = i
            End If
        End If
        If lngRowDes <> 0 Then
            .Redraw = False
            For i = 0 To .Cols - 1
                strDataTmp = .TextMatrix(lngRowDes, i)
                .TextMatrix(lngRowDes, i) = .TextMatrix(.Row, i)
                .TextMatrix(.Row, i) = strDataTmp
            Next
            strDataTmp = .RowData(lngRowDes)
            .RowData(lngRowDes) = .RowData(.Row)
            .RowData(.Row) = C2lng(strDataTmp)
            .Redraw = True
            .Row = lngRowDes
        End If
    End With
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -