form1.frm

本人开发的商业财务软件

      Dim PZid As Long
    Dim strSql As String
    rstPZfxtmp.CursorLocation = adUseClient
    rstPZfx.CursorLocation = adUseClient
    
    If Not isBalance() Then
        Exit Sub
    End If

    
    If isSavedCurrent = False Then
        isSavedCurrent = True
    Else
        If MsgBox("记录已保存，无需再存盘，你想覆盖原来的记录吗？选择是将覆盖原记录，选择否将退出", vbYesNo) <> vbYes Then
            Exit Sub
        End If
    End If
    
    
    rstPingZheng.CursorLocation = adUseClient
      i = 1
      '存储一般记帐科目
      dt = DTPicker1.Value
      strSql = "select * from PingZheng where 凭证号 = " & txtNumber.Text
      rstPingZheng.Open strSql, pubConn, adOpenDynamic, adLockOptimistic
    If rstPingZheng.RecordCount > 0 Then
        If MsgBox("记录已存在，你想覆盖原来的记录吗？", vbYesNo) <> vbYes Then
            Exit Sub
        Else
        
            With rstPingZheng
            .MoveFirst
            While Not .EOF
                .Delete
                .MoveNext
            Wend
            End With
            
            pubConn.Execute "delete * from pingzhengfx where 凭证号=" & txtNumber.Text
        End If
    End If
    If rst_Tmp_Ping.RecordCount = 0 Then
        MsgBox "没有输入凭证记录"
        Exit Sub
    End If
      rst_Tmp_Ping.MoveFirst
      While Not rst_Tmp_Ping.EOF
         rstPingZheng.AddNew
         rstPingZheng!凭证号 = CLng(Val(txtNumber.Text))
         rstPingZheng!月凭证号 = CLng(Val(Text1.Text))
         rstPingZheng!科目 = rst_Tmp_Ping!科目
         rstPingZheng!科目编号 = rst_Tmp_Ping!科目编号
         rstPingZheng!借方金额 = rst_Tmp_Ping!借方金额
         rstPingZheng!贷方金额 = rst_Tmp_Ping!贷方金额
         rstPingZheng!摘要 = rst_Tmp_Ping!摘要
         rstPingZheng!记录号 = i
         rstPingZheng!日期 = dt
         rstPingZheng!原始凭证数 = Val(MaskEdBox1.Text)
         rstPingZheng.Update
         '存储分析科目
         PZid = rst_Tmp_Ping!ID     ' 临时存储时分析科目中pizd 对应 凭证的中 记录号
         rstPZfxtmp.Open "select * from tempFx where pzid = " & PZid, pubConn, adOpenDynamic, adLockOptimistic
         rstPZfx.Open "select * from pingzhengfx", pubConn, adOpenDynamic, adLockOptimistic
         If rstPZfxtmp.RecordCount > 0 Then
            rstPZfxtmp.MoveFirst
            j = 1
            While Not rstPZfxtmp.EOF
                rstPZfx.AddNew
                rstPZfx!凭证号 = CLng(Val(txtNumber.Text))
                rstPZfx!月凭证号 = CLng(Val(Text1.Text))
                rstPZfx!科目 = rstPZfxtmp!科目
                rstPZfx!记录号 = j
                rstPZfx!编号 = rstPZfxtmp!科目编号
                rstPZfx!金额 = rstPZfxtmp!金额
                rstPZfx!PZid = rstPingZheng!ID  '分析科目对应的记录号
                rstPZfx.Update
                rstPZfxtmp.MoveNext
                j = j + 1
            Wend
         End If
         rstPZfxtmp.Close
         rstPZfx.Close
         rst_Tmp_Ping.MoveNext
         i = i + 1
      Wend
      
      rst_Tmp_Ping.MoveFirst
      
      rstPingZheng.Close
      '存储分析记帐科目
End Sub
Private Sub Command11_Click()
  On Error GoTo DeleteErrfx
  If MsgBox("你确定要删除吗？?", _
            vbQuestion + vbYesNo + vbDefaultButton2, _
            "lisypro") _
            <> vbYes Then
     Exit Sub
  End If
  With rstFxTemp
    .Delete
    .MoveNext
    If .EOF And .RecordCount <> 0 Then .MoveLast
  End With
    isSavedCurrent = False
  Exit Sub
DeleteErrfx:
 MsgBox Err.Description
End Sub

Private Sub DataGrid1_Change()
    isSavedCurrent = False
End Sub

Private Sub DataGrid1_DblClick()
      '响应双击DataGrid事件
   '   Debug.Print DataGrid1.Text; DataGrid1.Row; DataGrid1.Col
     Dim x As String
     x = rst_Tmp_Ping.Fields(DataGrid1.Col).Name
     If (x = "科目") Or (x = "科目编号") Then
         Load selKemu
         selKemu.isAddItem = False
         selKemu.Show (vbModal)
     End If
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
      '改变当前单元格时触发的事件
    iPzid = 0
    If rst_Tmp_Ping.RecordCount = 0 Then
        iPzid = 0
    Else
        If rst_Tmp_Ping.EOF Or rst_Tmp_Ping.BOF Then
            Exit Sub
        Else
            If Not IsNull(rst_Tmp_Ping!ID) Then iPzid = rst_Tmp_Ping!ID
        End If
    End If
    sqlFxtemp = "select * from tempFX where PZid = " & iPzid & " order by 记录号"
    
    Set DataGrid2.DataSource = Nothing
    DataGrid2.Refresh
    If rstFxTemp.State = adStateOpen Then
        rstFxTemp.Close
    End If
    rstFxTemp.Open sqlFxtemp, pubConn, adOpenDynamic, adLockOptimistic
    Set DataGrid2.DataSource = rstFxTemp
    DataGrid2.Refresh
End Sub

Private Sub DataGrid2_AfterColEdit(ByVal ColIndex As Integer)
    rstFxTemp.Update
End Sub
Private Sub DTPicker1_Change()
    Dim rstTemp As New ADODB.Recordset
    Dim strPZnum As String
    strPZnum = "select max(月凭证号) as idx from pingZheng idmonth where year(日期)=" _
                & Year(DTPicker1.Value) & " and  month(日期)=" & Month(DTPicker1.Value)
    rstTemp.Open strPZnum, pubConn
    
    If IsNull(rstTemp!idx) Then
            Text1.Text = "1"
        Else
            Text1.Text = Str(rstTemp!idx + 1)
        End If
    rstTemp.Close

    
    Set rstTemp = Nothing

    
End Sub

Private Sub Form_Load()
'初始化一般凭证科目 DataGrid1
    pubConn.Execute "delete * from  tempfx"
    pubConn.Execute "delete * from tempPingZheng"
    rst_Tmp_Ping.CursorLocation = adUseClient
    rst_Tmp_Ping.Open "select * from tempPingZheng order by id", pubConn, adOpenDynamic, adLockOptimistic
    Set DataGrid1.DataSource = rst_Tmp_Ping
    DataGrid1.Columns(0).Visible = False
    DataGrid1.Columns(1).Width = 1400
    DataGrid1.Columns(3).Width = 800
    DataGrid1.Columns(4).Width = 800
    DataGrid1.Columns(5).Width = 800
    DataGrid1.Refresh
    DTPicker1.Value = Date
    
    '初始化分析科目 DataGrid2
    If rst_Tmp_Ping.RecordCount = 0 Then
        ' MsgBox "空记录"
        iPzid = 0
    Else
        iPzid = rst_Tmp_Ping!ID
    End If
    sqlFxtemp = "select * from tempFX where PZid = " & iPzid
    rstFxTemp.CursorLocation = adUseClient
    rstFxTemp.Open sqlFxtemp, pubConn, adOpenDynamic, adLockOptimistic
    Set DataGrid2.DataSource = rstFxTemp
    DataGrid2.Refresh
    isSavedCurrent = True
    isPrinted = False
    
    '关于总凭证号的确定
    rstTemp.Open "select max(id) as idx from tempPingZheng", pubConn
    If IsNull(rstTemp!idx) Then
             iRec = 1
         Else
            iRec = rstTemp!idx + 1
            End If
    rstTemp.Close
    rstTemp.Open "select max(凭证号) as idx from PingZheng", pubConn
    If IsNull(rstTemp!idx) Then
            txtNumber.Text = "1"
            iStartNum = 1
            cmdPre.Enabled = False '记录号为1，将命令按钮变灰
        Else
            iStartNum = rstTemp!idx + 1
            txtNumber.Text = Str(iStartNum)
        End If
    rstTemp.Close
    '关于月凭证号的确定
    Dim strPZnum As String
    strPZnum = "select max(月凭证号) as idx from pingZheng idmonth where year(日期)=" _
                & Year(DTPicker1.Value) & " and  month(日期)=" & Month(DTPicker1.Value)
    rstTemp.Open strPZnum, pubConn
    
    If IsNull(rstTemp!idx) Then
            Text1.Text = "1"
        Else
            Text1.Text = Str(rstTemp!idx + 1)
        End If
    rstTemp.Close

    
    Set rstTemp = Nothing
    
    

    
End Sub
Private Sub Form_Unload(Cancel As Integer)
    rst_Tmp_Ping.Close
    rstFxTemp.Close
End Sub

Private Sub pzAdd_Click()
    If Not isSavedCurrent Then
        MsgBox "当前记帐凭证记录还未保存! ", vbInformation, "保存提示"
        Exit Sub
    End If
    
    If Not isPrinted Then
        If MsgBox("当前记帐凭证记录还未打印!,你也可以以后再打印本凭证，是否继续添加凭证？，选“是”将添加新凭证 ", _
                    vbYesNo, "打印提示") <> vbYes Then
               Exit Sub
        End If
    End If
    
    pubConn.Execute "delete * from tempPingZheng"
    pubConn.Execute "delete * from tempfx"
    
    '总凭证号确定
    Dim rstTemp As New ADODB.Recordset
    
    rstTemp.Open "select max(凭证号) as idx from PingZheng", pubConn
    If IsNull(rstTemp!idx) Then
             txtNumber.Text = Str(1)
         Else
            txtNumber.Text = Str(rstTemp!idx + 1)
    End If
    rstTemp.Close
    
    '关于月凭证号的确定
    Dim strPZnum As String
    strPZnum = "select max(月凭证号) as idx from pingZheng idmonth where year(日期)=" _
                & Year(DTPicker1.Value) & " and  month(日期)=" & Month(DTPicker1.Value)
    rstTemp.Open strPZnum, pubConn
    
    If IsNull(rstTemp!idx) Then
            Text1.Text = "1"
        Else
            Text1.Text = Str(rstTemp!idx + 1)
        End If
    rstTemp.Close


    rst_Tmp_Ping.Close
    rst_Tmp_Ping.Open "select * from tempPingZheng order by id", pubConn, adOpenDynamic, adLockOptimistic
    Set DataGrid1.DataSource = rst_Tmp_Ping
    DataGrid1.Columns(0).Visible = False
    DataGrid1.Columns(1).Width = 1400
    DataGrid1.Columns(3).Width = 800
    DataGrid1.Columns(4).Width = 800
    DataGrid1.Columns(5).Width = 800
    DataGrid1.Refresh
    
    
    '更新分析科目
        iPzid = 0
    If rst_Tmp_Ping.RecordCount = 0 Then
        iPzid = 0
    Else
        If rst_Tmp_Ping.EOF Or rst_Tmp_Ping.BOF Then
            Exit Sub
        Else
            If Not IsNull(rst_Tmp_Ping!ID) Then iPzid = rst_Tmp_Ping!ID
        End If
    End If
    sqlFxtemp = "select * from tempFX where PZid = " & iPzid & " order by 记录号"
    
    Set DataGrid2.DataSource = Nothing
    DataGrid2.Refresh
    If rstFxTemp.State = adStateOpen Then
        rstFxTemp.Close
    End If
    rstFxTemp.Open sqlFxtemp, pubConn, adOpenDynamic, adLockOptimistic
    Set DataGrid2.DataSource = rstFxTemp
    DataGrid2.Refresh


    MaskEdBox1.Text = "00"
End Sub