frmyh_ydzhx.frm

一个用VB写的财务软件源码

VERSION 5.00
Begin VB.Form frmYH_Ydzhx 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "核销已达账"
   ClientHeight    =   1860
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4395
   Icon            =   "frmYH_Ydzhx.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1860
   ScaleWidth      =   4395
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command1 
      Caption         =   "反核销"
      Height          =   375
      Left            =   1440
      TabIndex        =   7
      Top             =   1320
      Width           =   1215
   End
   Begin VB.Frame Frame2 
      Caption         =   "说明"
      Height          =   1080
      Left            =   120
      TabIndex        =   5
      Top             =   2160
      Visible         =   0   'False
      Width           =   3945
      Begin VB.Label Label2 
         Caption         =   "　　核销已达账将删除单位日记账和银行对账单的已达账，在进行核销之前，请做好数据备份工作，以防止因误删除而给工作带来不便。"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   765
         Left            =   180
         TabIndex        =   6
         Top             =   480
         Visible         =   0   'False
         Width           =   3615
      End
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   345
      Left            =   120
      TabIndex        =   1
      Top             =   1320
      Width           =   1065
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   345
      Left            =   3240
      TabIndex        =   2
      Top             =   1320
      Width           =   1065
   End
   Begin VB.Frame Frame1 
      Caption         =   "请选择要核销的银行科目"
      Height          =   945
      Left            =   210
      TabIndex        =   3
      Top             =   180
      Width           =   3945
      Begin VB.ComboBox cboKmmc 
         Height          =   300
         Left            =   1020
         Style           =   2  'Dropdown List
         TabIndex        =   0
         Top             =   390
         Width           =   2625
      End
      Begin VB.Label Label1 
         Caption         =   "科目："
         Height          =   225
         Left            =   240
         TabIndex        =   4
         Top             =   420
         Width           =   645
      End
   End
End
Attribute VB_Name = "frmYH_Ydzhx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rstTemp As ADODB.Recordset
Dim adoCmd As ADODB.Command
Dim sSQLTemp As String
Dim aKmdm() As String                       '存放银行最细一级科目
Dim i As Integer



Private Sub cboKmmc_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
        SendKeys "{tab}"
    
    End If
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOk_Click()
    If MsgBox("是否确认将" & cboKmmc.text & "科目的已达账账进行核销?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
        Me.MousePointer = vbHourglass
        Call ydzhx
        Me.MousePointer = vbDefault
        MsgBox cboKmmc.text & "银行科目已达账核销完毕！", vbOKOnly + vbInformation
    End If
End Sub

Private Sub Command1_Click()
  If MsgBox("是否确认将" & cboKmmc.text & "科目的已达账账进行反核销?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
            Me.MousePointer = vbHourglass
            Call ydzfhx
            Me.MousePointer = vbDefault
            MsgBox cboKmmc.text & "银行已达账反核销完毕！", vbOKOnly + vbInformation
        End If
End Sub

Private Sub form_load()

   '设置当前主窗体响应用户按键
    Me.KeyPreview = True
    
    Set adoCmd = New ADODB.Command
    adoCmd.ActiveConnection = glo.cnnMain
    adoCmd.CommandType = adCmdText
    
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    
    sSQLTemp = "SELECT kmdm,kmmc FROM tZW_km" & glo.sOperateYear & " WHERE IsYhz =-1 and IsEndKm = -1"
    rstTemp.Open sSQLTemp, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount <> 0 Then
            ReDim aKmdm(.RecordCount)
            .MoveFirst
            i = 0
            Do Until .EOF
                aKmdm(i) = Trim$("" & .Fields("kmdm").value)
                cboKmmc.AddItem Trim$("" & .Fields("kmmc").value) & "(" & Trim$("" & .Fields("kmdm").value) & ")"
                i = i + 1
                .MoveNext
            Loop
        End If
    End With
    cboKmmc.ListIndex = 0
End Sub

'当按CTRL-R键,执行银行已达账反核销
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim CtrlDown As Boolean
    
    CtrlDown = (Shift And vbCtrlMask) > 0
    If KeyCode = vbKeyR And CtrlDown Then
        If MsgBox("是否确认将" & cboKmmc.text & "科目的已达账账进行反核销?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
            Me.MousePointer = vbHourglass
            Call ydzfhx
            Me.MousePointer = vbDefault
            MsgBox cboKmmc.text & "银行已达账反核销完毕！", vbOKOnly + vbInformation
        End If
    End If
End Sub

'核销已达账
Private Sub ydzhx()

    adoCmd.CommandText = "UPDATE tZW_Pzsj" & glo.sOperateYear & " SET yhdz_hxbz =-1" & _
                         " WHERE kmdm = '" & aKmdm(cboKmmc.ListIndex) & "'" & _
                         " AND yhdz_lqbz > 0"
    adoCmd.Execute
    adoCmd.CommandText = "UPDATE tZW_Yhdzd" & glo.sOperateYear & " SET hxbz =-1" & _
                         " WHERE kmdm = '" & aKmdm(cboKmmc.ListIndex) & "'" & _
                         " AND lqbz > 0"
    adoCmd.Execute
End Sub
'核销已达账
Private Sub ydzfhx()

    adoCmd.CommandText = "UPDATE tZW_Pzsj" & glo.sOperateYear & " SET yhdz_hxbz = 0" & _
                         " WHERE kmdm = '" & aKmdm(cboKmmc.ListIndex) & "'" & _
                         " AND yhdz_hxbz = -1"
    adoCmd.Execute
    adoCmd.CommandText = "UPDATE tZW_Yhdzd" & glo.sOperateYear & " SET hxbz = 0" & _
                         " WHERE kmdm = '" & aKmdm(cboKmmc.ListIndex) & "'" & _
                         " AND hxbz = -1"
    adoCmd.Execute
End Sub