📄 frmyh_yhdzdlr.frm
字号:
Caption = "编辑(&E)"
Begin VB.Menu mnuNew
Caption = "增加"
Shortcut = ^N
End
Begin VB.Menu mnuSave
Caption = "保存"
Shortcut = ^S
End
Begin VB.Menu mnuCancel
Caption = "取消"
Shortcut = ^C
End
Begin VB.Menu mnuDelete
Caption = "删除"
Shortcut = ^D
End
Begin VB.Menu mnuLine2
Caption = "-"
End
Begin VB.Menu mnuFilter
Caption = "筛选"
Shortcut = ^L
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
End
End
Attribute VB_Name = "frmYH_Yhdzdlr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'2001.01.22肖兆芹修改
Option Explicit
'以下一段常量用于窗体frm_print的CELL打印
'-------------------------------------------------------------
'Cell单元格对齐方式: 33 = 左对齐, 34 = 右对齐, 36 = 居中对齐;
Const ROWS_PAGE = 28 '每页行数
Const COL_START = 1 '开始列
Const COL_RQ = 1 '日期
Const COL_JSFS = 2 '结算方式
Const COL_BILL_NUMBER = 3 '票号
Const COL_DEBIT_MONEY = 4 '借方金额
Const COL_CREDIT_MONEY = 5 '贷方金额
Const COL_BALANCE = 6 '余额
Const COL_ZY = 7 '摘要
Const COL_END = 7 '结束列
Const ROW_TITLE = 1 '标题
Const ROW_BLANK = 2 '空白行
Const ROW_SUBJNAME = 3 '页眉
Const ROW_HEAD1 = 4 '页标头行
Const ROW_GRID_START = 5 '表格开始行
''''Const CRB_LINE = vbBlack '表格线颜色
'缺省列宽
'CELL 1单元长度 = 3.8mm
Const ColWidth = "90,110,100,160,160,160,240"
Dim sEnterName As String '单位名称
Dim IsChangeCurrentTable As Boolean '是否改变当前表格中的内容
Dim frmP As frmPrint '通用打印窗体(CELL)
'-------------------------------------------------------------
Dim Myfrmcx As frmYH_Yhcxtj
Dim rstTemp As ADODB.Recordset
Dim adoCmd As ADODB.Command
Dim sSQL As String
Dim sSQLTemp As String
Dim i As Integer
Dim j As Integer
Dim Yhdzqyrq As String '银行对账启用日期
Dim OldRow As Integer '当前获得焦点的单元格所在行数
Dim ErrorCol As Integer '存放出错列
Dim NewRow As Integer '表格移动到下一个获得焦点的单元格的行数
Dim NewCol As Integer '表格移动到下一个获得焦点的单元格的列数
Dim CurrentRowNum As Integer '存放新增表格行的行数
Dim IsModify As Boolean '判断当前行的内容是否被修改
Dim IsDateModify As Boolean '判断当前行的日期是否被修改, 用于表格自动按日期排序
Dim IsRefresh As Boolean '当移动单元格时判断当前是否在刷新表格
Dim IsDelete As Boolean '判断当前是否在删除状态
Dim iYhqcye As Double '银行对账期初余额
Dim frmH_Summ As New frmIN_Summary
Private Sub dtpEdit_Change()
mfgYhdzdlr.TextMatrix(mfgYhdzdlr.row, 1) = dtpEdit.value
End Sub
Private Sub form_load()
Dim iYhtzqye As Double '银行对账启用时的调整前余额
Dim iYhqcLjj As Double '银行对账启用时未核销的对账单的累计借方金额
Dim iYhqcLjd As Double '银行对账启用时未核销的对账单的累计贷方金额
Dim iYhljjhx As Double '对账单日期大于启用日期的已核销的对账单借方金额累计数
Dim iYhljdhx As Double '对账单日期大于启用日期的已核销的对账单贷方金额累计数
OldRow = 0
iYhqcye = 0
iYhtzqye = 0
iYhqcLjj = 0
iYhqcLjd = 0
iYhljjhx = 0
iYhljdhx = 0
IsModify = False
IsDateModify = False
IsDelete = False
IsRefresh = False
IsChangeCurrentTable = True
Set Myfrmcx = New frmYH_Yhcxtj
Set adoCmd = New ADODB.Command
Load Myfrmcx
adoCmd.ActiveConnection = glo.cnnMain
Set rstTemp = New ADODB.Recordset
rstTemp.CursorLocation = adUseClient
sSQLTemp = "SELECT * FROM tZW_yhdzd" & glo.sOperateYear & _
" WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & _
"'AND (qcbz = 0 OR (qcbz = 1 and hxbz = 0) OR (qcbz = 2 AND hxbz =-1))"
rstTemp.Open sSQLTemp, glo.cnnMain, adOpenStatic, adLockReadOnly
With rstTemp
If .RecordCount <> 0 Then
.MoveFirst
Do Until .EOF
If .Fields("qcbz").value = 0 Then
iYhtzqye = .Fields("je").value
ElseIf .Fields("qcbz").value = 1 Then
If .Fields("fx").value = "借" Then
iYhqcLjj = iYhqcLjj + .Fields("je").value
Else
iYhqcLjd = iYhqcLjd + .Fields("je").value
End If
ElseIf .Fields("qcbz").value = 2 Then
If .Fields("fx").value = "借" Then
iYhljjhx = iYhljjhx + .Fields("je").value
Else
iYhljdhx = iYhljdhx + .Fields("je").value
End If
End If
.MoveNext
Loop
End If
End With
'银行期初余额 等于 银行对账启用时调整前余额 加 大于启用日期的已核销对账单的累计贷方余额
' 减 银行对账启用时未核销对账单的累计贷方余额
iYhqcye = iYhtzqye '+ (iYhljdhx - iYhljjhx) - (iYhqcLjd - iYhqcLjj)
lblKmmc.Caption = "科目：" & frmYH_Yhkmxz.Kmmc & "(" & frmYH_Yhkmxz.kmdm & ")"
lblYhdzdqcye.Caption = "银行期初余额：" & Format(iYhqcye, "##,##0.00")
Set rstTemp = New ADODB.Recordset
rstTemp.CursorLocation = adUseClient
sSQLTemp = "SELECT * FROM tZW_jsfs" & glo.sOperateYear & " WHERE bEnd =-1 order by cCode"
rstTemp.Open sSQLTemp, glo.cnnMain, adOpenStatic, adLockReadOnly
With rstTemp
If .RecordCount <> 0 Then
.MoveFirst
cboEdit.AddItem " "
Do Until .EOF
cboEdit.AddItem Trim$("" & .Fields("cCode").value) & " " & Trim$("" & .Fields("cName").value)
.MoveNext
Loop
End If
End With
Set rstTemp = New ADODB.Recordset
rstTemp.CursorLocation = adUseClient
sSQLTemp = "SELECT * FROM tZW_Yhdzqyrq WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & "'"
rstTemp.Open sSQLTemp, glo.cnnMain, adOpenStatic, adLockReadOnly
With rstTemp
If .RecordCount <> 0 Then
Yhdzqyrq = Format(.Fields("qyrq").value, "yyyy-mm-dd")
End If
End With
rstTemp.Close
Label5.Caption = "启用日期：" + Yhdzqyrq
Set rstTemp = Nothing
cboEdit.ListIndex = 0
tBr.Buttons("save").Enabled = False
tBr.Buttons("cancel").Enabled = False
mnuSave.Enabled = False
mnuCancel.Enabled = False
Call SetHead
' sSQL = "SELECT * FROM tZW_yhdzd" & glo.sOperateYear & _
" WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & _
"' AND qcbz <> 0 and hxbz = 0 and rq>=" + GetDateString(g_FLAT, Format(Yhdzqyrq, "yyyy-mm-dd")) + " ORDER BY rq,jsfsCode,Bill"
sSQL = "SELECT * FROM tZW_yhdzd" & glo.sOperateYear & _
" WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & _
"' AND qcbz <> 0 and rq>=" + GetDateString(g_FLAT, Format(Yhdzqyrq, "yyyy-mm-dd")) + " ORDER BY rq,jsfsCode,Bill"
Call FillGrid(sSQL)
'------------------------------
'得到当前账套的单位名称
sEnterName = GetDWMC
If sEnterName = "" Then
MsgBox "缺少单位名称！", vbInformation
Exit Sub
End If
'根据当前MSFLEXGRID表格生成CELL表格
If IsChangeCurrentTable Then
IsChangeCurrentTable = False
Call DrawCellTable
End If
'------------------------------
End Sub
'设置表头
Private Sub SetHead()
With mfgYhdzdlr
'将表格的第一列隐藏, 第一列用于存放银行对账单表的主键id
.ColWidth(0) = 0
.ColWidth(1) = 0
.ColWidth(2) = 1300
.ColWidth(3) = 1200
.ColWidth(4) = 1200
.ColWidth(5) = 1800
.ColWidth(6) = 1800
.ColWidth(7) = 1800
.ColWidth(8) = 3000
.ColAlignment(0) = 4
.ColAlignment(1) = 4
.ColAlignment(2) = 4
.ColAlignment(3) = 1
.ColAlignment(4) = 4
.ColAlignment(5) = 7
.ColAlignment(6) = 7
.ColAlignment(7) = 7
.ColAlignment(8) = 1
.row = 0
.RowHeight(0) = 400
For j = 0 To .Cols - 1
.col = j
.CellFontSize = 11
.CellAlignment = 4
Next j
End With
cmdHelp.Height = 300
cmdHelp.Width = 320
dtpEdit.value = Date
End Sub
'从银行对账单表中取出期初对账单, 然后填充表格;
Private Sub FillGrid(ByVal sSQL As String)
Dim iYhdzdye As Double
mfgYhdzdlr.Redraw = False
IsRefresh = True
Set rstTemp = New ADODB.Recordset
rstTemp.CursorLocation = adUseClient
With rstTemp
.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
mfgYhdzdlr.Rows = 1
If .RecordCount = 0 Then
tBr.Buttons("delete").Enabled = False
mnuDelete.Enabled = False
Else
.MoveFirst
For i = 1 To .RecordCount
If .Fields("fx").value = "借" Then
If i = 1 Then
iYhdzdye = GetQc(.Fields("ID").value, .Fields("Rq").value) - .Fields("je").value
Else
iYhdzdye = Val(Format(mfgYhdzdlr.TextMatrix(i - 1, 7), "###0.00")) _
- .Fields("je").value
End If
mfgYhdzdlr.AddItem .Fields("id").value & vbTab & _
.Fields("qcbz").value & vbTab & _
Format(.Fields("rq").value, "yyyy-mm-dd") & vbTab & _
Trim$("" & .Fields("jsfsCode").value) & " " & Trim$("" & .Fields("jsfsname").value) & vbTab & _
Trim$("" & .Fields("bill").value) & vbTab & _
Format(.Fields("je").value, "##,##0.00") & vbTab & _
"" & vbTab & _
Format(iYhdzdye, "##,##0.00") & vbTab & _
Trim$("" & .Fields("zy").value) & vbTab & i
mfgYhdzdlr.RowHeight(i) = cboEdit.Height
If .Fields("hxbz") <> 0 Then
mfgYhdzdlr.RowHeight(i) = 0
End If
Else
If i = 1 Then
iYhdzdye = GetQc(.Fields("ID").value, .Fields("Rq").value) + .Fields("je").value
Else
iYhdzdye = Val(Format(mfgYhdzdlr.TextMatrix(i - 1, 7), "###0.00")) _
+ .Fields("je").value
End If
mfgYhdzdlr.AddItem .Fields("id").value & vbTab & _
.Fields("qcbz").value & vbTab & _
Format(.Fields("rq").value, "yyyy-mm-dd") & vbTab & _
Trim$("" & .Fields("jsfsCode").value) & " " & Trim$("" & .Fields("jsfsname").value) & vbTab & _
Trim$("" & .Fields("bill").value) & vbTab & _
"" & vbTab & _
Format(.Fields("je").value, "##,##0.00") & vbTab & _
Format(iYhdzdye, "##,##0.00") & vbTab & _
Trim$("" & .Fields("zy").value) & vbTab & i
mfgYhdzdlr.RowHeight(i) = cboEdit.Height
If .Fields("hxbz") <> 0 Then
mfgYhdzdlr.RowHeight(i) = 0
End If
End If
If .Fields("lqbz").value > 0 Then
mfgYhdzdlr.row = i
For j = 0 To mfgYhdzdlr.Cols - 1
mfgYhdzdlr.col = j
mfgYhdzdlr.CellBackColor = &HFFFFC0
Next j
End If
.MoveNext
Next i
End If
End With
With mfgYhdzdlr
For i = 1 To mfgYhdzdlr.Rows - 1
.RowHeight(i) = cboEdit.Height
Next i
.row = 0
.col = 0
End With
mfgYhdzdlr.Redraw = True
IsRefresh = False
End Sub
Private Sub cboEdit_KeyDown(KeyCode As Integer, Shift As Integer)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -