ʰ

VB开发的ERP系统

        Label2(2).Caption = Format(rs.Fields("billdate"), "yyyy年mm月dd日")
    Else
        Label2(2).Caption = Format(Now, "yyyy-mm-dd")
    End If
    Call XSSJ
    Call Sub_ShowBill
End Sub

Private Sub Form_Resize()
    
    On Error Resume Next
    With CxbbGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
        .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140
    
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        Call bbyl(True)
    Case "dy"                                            '打 印
        Call bbyl(False)
    Case "fh"          '退出
        Unload Me
    Case "bz"
        Call F1bz
    End Select
End Sub

'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
    '以下为依据实际情况自定义部分[
    '在此填写文本框录入事后处理程序
    TextChangeLock = True
    LrText(3) = Val(Format(LrText(0), "0.00")) + Val(Format(LrText(1), "0.00")) - Val(Format(LrText(2), "0.00"))
    LrText(7) = Val(Format(LrText(4), "0.00")) + Val(Format(LrText(5), "0.00")) - Val(Format(LrText(6), "0.00"))
    LrText(Index) = Format(LrText(Index), "#,###.00")
    LrText(3) = Format(LrText(3), "#,###.00")
    LrText(7) = Format(LrText(7), "#,###.00")
    TextChangeLock = False
    ']以上为依据实际情况自定义部分
End Sub

Private Sub LrText_Change(Index As Integer)
    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
    '打开有效性判断锁
    TextValiJudgeLock(Index) = False
    '限制字段录入长度
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
    Select Case Textint(Index, 1)
    Case 8           '金额型
        Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
    Case 9           '数量型
        Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
    Case 10          '单价型
        Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
    Case Else        '其他小数类型控制
        If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
            Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
        End If
    End Select
    TextChangeLock = False '解锁
End Sub

Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
    Call TextShow(Index)
    CurTextIndex = Index
    LrText(Index).SelStart = Len(LrText(Index))
End Sub

Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
    Select Case KeyCode
    Case vbKeyF2
        Call Text_Help(Index)
    End Select
End Sub

Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
    Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub

'事中判断
Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
    If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then
        Call TextYxxpd(Index)
    End If
    Call Wbklrwbcl(Index)
End Sub

'录入字段帮助
Private Sub Text_Help(Index As Integer)
    If Not Textboolean(Index, 1) Then
        Exit Sub
    End If
    TextValiJudgeLock(Index) = True
    Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
    If Len(Xtfhcs) <> 0 Then
        If Textint(Index, 3) = 1 Then
            LrText(Index).Text = Xtfhcsfz
            LrText(Index).Tag = Xtfhcs
        Else
            LrText(Index).Text = Xtfhcs
            LrText(Index).Tag = Xtfhcsfz
        End If
    End If
    TextValiJudgeLock(Index) = False
    LrText(Index).SetFocus
End Sub

'文本框得到焦点,显示相应信息
Private Sub TextShow(Index As Integer)
    '填写文本框得到焦点,进行相应信息处理程序
    TextChangeLock = True
    LrText(Index) = Format(LrText(Index), "0.00")
    TextChangeLock = False
End Sub

'录入文本框初始化
Private Sub Wbkcsh()
    Dim Jsqte As Integer
    '最大录入文本框索引值
    Max_Text_Index = Textvar(1)
    ReDim TextValiJudgeLock(Max_Text_Index)
    For Jsqte = 0 To Max_Text_Index
        If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
            If Textboolean(Jsqte, 1) Then
                'If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
                '    Load Ydcommand1(Jsqte)
                'End If
                'Ydcommand1(Jsqte).Visible = True
                'Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
            End If
            TextChangeLock = True
            LrText(Jsqte).Text = ""
            LrText(Jsqte).Tag = ""
            If Textint(Jsqte, 5) <> 0 Then
                LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
            End If
            TextChangeLock = False
        End If
        TextValiJudgeLock(Jsqte) = True
    Next Jsqte
End Sub

'文本框有效性判断
Private Function TextYxxpd(Index As Integer) As Boolean
    Dim Sqlstr As String
    Dim Findrec As ADODB.Recordset
    '文本框内容未曾改变不进行有效性判断
    If TextValiJudgeLock(Index) Then
        TextYxxpd = True
        Exit Function
    End If
    If Trim(LrText(Index)) = "" Then
        LrText(Index).Tag = ""
        Call Wbklrwbcl(Index)
        TextValiJudgeLock(Index) = True
        TextYxxpd = True
        Exit Function
    End If
    Select Case Textint(Index, 4)
    Case 1      '编码型
        Sqlstr = Trim(Textstr(Index, 5))
        Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
        Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Findrec.EOF Then
            Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
            LrText(Index).SetFocus
            Exit Function
        Else
            Select Case Textint(Index, 3)
            Case 0
                If Len(Trim(Textstr(Index, 2))) <> 0 Then
                    LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                End If
                If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                    LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                End If
            Case 1
                If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                    LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                End If
                If Len(Trim(Textstr(Index, 2))) <> 0 Then
                    LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                End If
            End Select
        End If
    Case 2      '日期型
        If IsDate(LrText(Index).Text) Then
            LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
        Else
            Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
            LrText(Index).SetFocus
            Exit Function
        End If
    Case 3      '其他类型
        
    End Select
    TextValiJudgeLock(Index) = True
    TextYxxpd = True
End Function

'显示所有数据
Private Sub XSSJ()
    Dim RecTemp As New ADODB.Recordset
    TextChangeLock = True
    If Trim(YH_FrmYeb.CxbbGrid.TextMatrix(YH_FrmYeb.CxbbGrid.Row, 4)) = "" Then
        LrText(4).Text = "0.00"
    Else
        LrText(4).Text = YH_FrmYeb.CxbbGrid.TextMatrix(YH_FrmYeb.CxbbGrid.Row, 4)
    End If
    If Trim(YH_FrmYeb.CxbbGrid.TextMatrix(YH_FrmYeb.CxbbGrid.Row, 3)) = "" Then
        LrText(0).Text = "0.00"
    Else
        LrText(0).Text = YH_FrmYeb.CxbbGrid.TextMatrix(YH_FrmYeb.CxbbGrid.Row, 3)
    End If
    
    
    '从银行对帐期初数据
    SQL_Str = "select sum(jfje) as jfje, sum(dfje) as dfje from cwzz_bankbill where rectype=1 and bdelete=0 and ccode='" & Val(Label2(1).Caption) & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SQL_Str)
    If RecTemp.EOF = False Then
        If IsNull(RecTemp.Fields!jfje) = False Then
            LrText(1) = RecTemp.Fields!jfje
        End If
        If IsNull(RecTemp.Fields!dfje) = False Then
            LrText(2) = RecTemp.Fields!dfje
        End If
    Else
        LrText(1) = 0
        LrText(2) = 0
    End If
    '银行本期数据
    SQL_Str = "select sum(jfje) as jfje, sum(dfje) as dfje from cwzz_bankbill where rectype=2 and bdelete=0 and ccode='" & Val(Label2(1).Caption) & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SQL_Str)
    If RecTemp.EOF = False Then
        If IsNull(RecTemp.Fields!jfje) = False Then
            LrText(2) = Val(LrText(2)) + RecTemp.Fields!jfje
        End If
        If IsNull(RecTemp.Fields!dfje) = False Then
            LrText(1) = Val(LrText(1)) + RecTemp.Fields!dfje
        End If
    End If
    
    '单位期初数据
    SQL_Str = "select sum(jfje) as jfje,sum(dfje) as dfje from cwzz_rjznotcheck where rectype=1 and bdelete=0 and ccode='" & Val(Label2(1).Caption) & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SQL_Str)
    If RecTemp.EOF = False Then
        If IsNull(RecTemp.Fields!jfje) = False Then
            LrText(5) = Val(LrText(5)) + RecTemp.Fields!jfje
        End If
        If IsNull(RecTemp.Fields!dfje) = False Then
            LrText(6) = Val(LrText(6)) + RecTemp.Fields!dfje
        End If
    Else
        LrText(5) = 0
        LrText(6) = 0
    End If
    '本期发生数据
    SQL_Str = "Select SUM(JFJE) As Jfje,SUM(DFJE) As Dfje From Cwzz_V_AccVouch where Ccode='" & Val(Label2(1).Caption) & "' " _
    & "And Convert(Char(8),Ddate,112)>=(Select Convert(Char(8),Ddate,112) From " _
    & "Cwzz_RjzNotCheck Where RecType=0 And Ccode='" & Val(Label2(1).Caption) & "') And BDelete=0 " _
    & "And Convert(Char(6),Ddate,112)<=(select Convert(Char(6),max(qsrq),112) from gy_kjrlb where cwzzjzbz='1')"
    
    
    'SQL_Str = "select sum(jfje) as jfje, sum(dfje) as dfje from cwzz_accvouchsub where bdelete=0 and ccode='" & Val(Label2(1).Caption) & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SQL_Str)
    If RecTemp.EOF = False Then
        If IsNull(RecTemp.Fields!jfje) = False Then
            LrText(5) = Val(LrText(5)) + RecTemp.Fields!jfje
        End If
        If IsNull(RecTemp.Fields!dfje) = False Then
            LrText(6) = Val(LrText(6)) + RecTemp.Fields!dfje
        End If
    End If
    
    
    '窗体调入时，计算调整前余额，调整后余额，转换各金额
    LrText(3) = Val(Format(LrText(0).Text, "0.00")) + Val(Format(LrText(1), "0.00")) - Val(Format(LrText(2), "0.00"))
    LrText(7) = Val(Format(LrText(4), "0.00")) + Val(Format(LrText(5), "0.00")) - Val(Format(LrText(6), "0.00"))
    LrText(0) = Format(LrText(0), "#,###.00")
    LrText(1) = Format(LrText(1), "#,###.00")
    LrText(2) = Format(LrText(2), "#,###.00")
    LrText(3) = Format(LrText(3), "#,###.00")
    LrText(4) = Format(LrText(4), "#,###.00")
    LrText(5) = Format(LrText(5), "#,###.00")
    LrText(6) = Format(LrText(6), "#,###.00")
    LrText(7) = Format(LrText(7), "#,###.00")
    TextChangeLock = False
End Sub

'显示银行．企业调整前．后余额
Private Sub Sub_ShowBill()
    Dim Rowjsq As Integer
    With CxbbGrid
        .Rows = 5
        .TextMatrix(1, 0) = "调整前余额": .TextMatrix(1, 1) = LrText(0)
        .TextMatrix(2, 0) = "加:银行已收  企业未收": .TextMatrix(2, 1) = LrText(1)
        .TextMatrix(3, 0) = "减:银行已付  企业未付": .TextMatrix(3, 1) = LrText(2)
        .TextMatrix(4, 0) = "调整后余额": .TextMatrix(4, 1) = LrText(3)
        .TextMatrix(1, 2) = "调整前余额": .TextMatrix(1, 3) = LrText(4)
        .TextMatrix(2, 2) = "加:企业已收  银行未收": .TextMatrix(2, 3) = LrText(5)
        .TextMatrix(3, 2) = "减:企业已付  银行未付": .TextMatrix(3, 3) = LrText(6)
        .TextMatrix(4, 2) = "调整后余额": .TextMatrix(4, 3) = LrText(7)
        For Rowjsq = 0 To .Rows - 1
            .RowHeight(Rowjsq) = 350
        Next Rowjsq
    End With
End Sub

'报表打印预览
Private Sub bbyl(bbylte As Boolean)
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    '报表小标题行数
    Bbxbtgs = 1
    '报表表尾行数
    Bbbwhgs = 1
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    '报表主标题
    Bbzbt = ReportTitle
    Bbxbt(1) = Space(0) + Fun_FormatOutPut("启用日期:" + Trim(Label2(2).Caption), 30)
    Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("科目编码:" + Trim(Label2(1).Caption), 26)
    '报表小标题组织形式
    '报表行组织形式(0-居左 1-居中 2-居右)
    bbxbtzzxs(1) = 0
    Bbbwhzzxs(1) = 1
    '生成报表数据
    Call Scyxsjb(CxbbGrid)
    '生成报表
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        '关闭预览窗体
        Unload DY_Tybbyldy
    End If
End Sub