📄 feenumeration.frm
字号:
Dim SeleXZ As String
Private Sub Form_Load()
Dim intRecCount, intCounter As Integer
On Error Resume Next
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
List2.Enabled = False
Frame3.Visible = False
PrBar2.Visible = False
OpenMdb
Set MdbR = NdMd.OpenRecordset("乡镇档案")
MdbR.MoveLast
intCounter = MdbR.RecordCount
MdbR.MoveFirst
For intRecCount = 0 To intCounter - 1
List1.AddItem& MdbR.Fields("镇代码") & " " & MdbR.Fields("简称") & ""
MdbR.MoveNext
Next intRecCount
List1.ListIndex = 0
GzNian = Year(Date)
GzYue = Format(Month(Date), "0#")
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Star_stop = True
Screen.MousePointer = 0
MdbR.Close
NdMd.Close
End Sub
Private Sub List1_Click()
On Error Resume Next
Dim intRecCount, intCounter As Integer
Set MdbR = NdMd.OpenRecordset("SELECT 村代码,简称 FROM 村档案 WHERE 村档案.镇代码 ='" & Mid(Trim(List1.Text), 1, 3) & "'")
MdbR.MoveLast
intCounter = MdbR.RecordCount
MdbR.MoveFirst
List2.Clear
For intRecCount = 0 To intCounter - 1
List2.AddItem& MdbR.Fields("村代码") & "" & MdbR.Fields("简称") & ""
MdbR.MoveNext
Next intRecCount
List2.ListIndex = 0
Star_stop = False
End Sub
Private Sub Command1_Click()
Dim i As Integer
On Error Resume Next
If Command1.Caption = "停止(&S)" Then
Command1.Caption = "开始(&S)"
Star_stop = True
PrBar2.Value = 0
PrBar2.Visible = False
Exit Sub
Else
Command1.Caption = "停止(&S)"
Command2.Enabled = False
If Option1 Then '全部
If Len(UserSeek) = 0 Then
GzYue = Format(Month(Date), "0#")
Call sTruInfo
End If
Set MdbR = NdMd.OpenRecordset("SELECT * From 用户电费 where ISNULL(用户电费.[" & AA & "]) <> True AND VAL(用户电费.[" & AA & "]) <>0 order by 用户电费.组合编码 asc")
If MdbR.eof Then
MsgBox "本月新数据未上载入库或无用户记录！", vbInformation
Command1.Caption = "开始(&S)"
Command2.Enabled = True
Exit Sub
Else
PrBar1.Visible = True
Frame3.Visible = True
Screen.MousePointer = 11
Call CalcFEE(0)
Screen.MousePointer = 0
PrBar1.Visible = False
Frame3.Visible = False
Command1.Caption = "开始(&S)"
'开始停止标记
Star_stop = False
Command2.Enabled = True
PrBar1.Value = PrBar1.Min
End If
Else '部分
If Len(UserSeek) = 0 Then
GzYue = Format(Month(Date), "0#")
Call sTruInfo
End If
PrBar2.Visible = True
PrBar2.Min = 0
PrBar2.Value = 0
PrBar2.Max = List2.ListCount
Screen.MousePointer = 11
For i = 0 To PrBar2.Max - 1
If Star_stop Then Exit For
If List2.Selected(i) Then
SeleXZ = List2.List(i)
Call CalcFEE(1)
End If
PrBar2.Value = i
Next
Screen.MousePointer = 0
PrBar1.Visible = False
PrBar2.Visible = False
Frame3.Visible = False
Command1.Caption = "开始(&S)"
Star_stop = False
Command2.Enabled = True
End If
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Option1_Click()
Option1.Value = True
Option2.Value = False
List2.Enabled = False
End Sub
Private Sub Option2_Click()
Option1.Value = False
Option2.Value = True
Frame2.Enabled = True
List1.Enabled = True
List2.Enabled = True
End Sub
Sub CalcFEE(ReSum As Integer)
Dim i As Integer, js As Integer, Bws As Integer
Dim FzDs As Long, dlFlag As Long
Dim JsRecord As Recordset
Dim CbmStr As String
On Error Resume Next
If ReSum = 0 Then
If Check1.Value Then
Set MdbR = NdMd.OpenRecordset("SELECT DISTINCT 组合编码 From 用户电费 where ISNULL(用户电费.[" & AA & "]) <> True AND VAL(用户电费.[" & AA & "]) <>0 and 用户电费.[" & LL & "]=false order by 用户电费.组合编码 asc")
Else
Set MdbR = NdMd.OpenRecordset("SELECT DISTINCT 组合编码 From 用户电费 where ISNULL(用户电费.[" & AA & "]) <> True AND VAL(用户电费.[" & AA & "]) <>0 order by 用户电费.组合编码 asc")
End If
Else
If Check1.Value Then
Set MdbR = NdMd.OpenRecordset("SELECT DISTINCT 组合编码 From 用户电费 WHERE 用户电费.镇村代码='" & Left(List1.Text, 3) & Left(SeleXZ, 3) & "' and ISNULL(用户电费.[" & AA & "]) <> True AND VAL(用户电费.[" & AA & "]) <>0 and 用户电费.[" & LL & "]=false ORDER BY 用户电费.组合编码")
Else
Set MdbR = NdMd.OpenRecordset("SELECT DISTINCT 组合编码 From 用户电费 WHERE 用户电费.镇村代码='" & Left(List1.Text, 3) & Left(SeleXZ, 3) & "' and ISNULL(用户电费.[" & AA & "]) <> True AND VAL(用户电费.[" & AA & "]) <>0 ORDER BY 用户电费.组合编码")
End If
End If
MdbR.MoveLast
MdbR.MoveFirst
PrBar1.Max = MdbR.RecordCount
PrBar1.Min = 0
PrBar1.Visible = True
With MdbR
For i = 0 To MdbR.RecordCount 'PrBar1.Max - 1
dlFlag = 0
If Star_stop Then Exit For
Set JsRecord = NdMd.OpenRecordset("SELECT 用户电费.多表序号,用户电费.多价表,用户电费.用户类型,用户电费.镇村代码,用户电费.用户编码,用户电费.用户名称,用户电费.调整原因,用户电费.[" & AAA & "] AS 上期示数, 用户电费.[" & AA & "] AS 本期示数,用户电费.表损, 用户电费.倍率,用户电费.[" & LL & "] AS 计算,用户电费.[" & BB & "] AS 调整电量,用户电费.[" & CC & "] AS 本次电量, 用户电费.[" & DD & "] AS 合计电量,用户电费.旧表电量,用户电费.电价,用户电费.电建,用户电费.三峡,用户电费.[" & EE & "] AS 本期余额,用户电费.[" & DDD & "] AS 上期余额, 用户电费.[" & FF & "] AS 滞纳金, 用户电费.[" & GG & "] AS 本次电费, 用户电费.[" & HH & "] AS 合计电费,用户电费.[" & JJ & "] AS 发票打印,用户电费.[" & KK & "] AS 交费情况,用户电费.组合编码,用户电费.比率1,用户电费.比率2,用户电费.比率1电价,用户电费.比率2电价,用户电费.比率1电量,用户电费.比率2电量,用户电费.比率1电费,用户电费.比率2电费 " _
& "From 用户电费 WHERE 用户电费.组合编码='" & MdbR.Fields!组合编码 & "' order by 用户电费.多表序号 asc")
'If MdbR.Fields!组合编码 = "0014130189" Then Stop
For js = 1 To JsRecord.RecordCount
With JsRecord
Select Case .Fields!用户类型
Case "工业动力"
sxMeter = True
Case Else '普通照明
If .Fields!多价表 Then
'判断多价表是否翻转
If .Fields!调整原因 = "翻转" Then
'求出表位数
Bws = Len(Trim(Str(Val(.Fields!上期示数))))
Select Case Bws
Case 3
FzDs = (1000 + Val(.Fields!本期示数)) - Val(.Fields!上期示数)
Case 4
FzDs = (10000 + Val(.Fields!本期示数)) - Val(.Fields!上期示数)
Case 5
FzDs = (100000 + Val(.Fields!本期示数)) - Val(.Fields!上期示数)
Case 6
FzDs = (1000000 + Val(.Fields!本期示数)) - Val(.Fields!上期示数)
Case 7
FzDs = (10000000 + Val(.Fields!本期示数)) - Val(.Fields!上期示数)
End Select
.Edit
.Fields!比率1电量 = ((FzDs * IIf(.Fields!倍率 = 0, 1, .Fields!倍率)) + .Fields!表损 + IIf(IsNull(.Fields!调整电量) = True, 0, .Fields!调整电量)) * .Fields!比率1
.Fields!比率2电量 = ((FzDs * IIf(.Fields!倍率 = 0, 1, .Fields!倍率)) + .Fields!表损 + IIf(IsNull(.Fields!调整电量) = True, 0, .Fields!调整电量)) * .Fields!比率2
.Fields!本次电量 = .Fields!比率1电量 + .Fields!比率2电量
.Fields!合计电量 = .Fields!本次电量
.Fields!比率1电费 = .Fields!比率1电量 * .Fields!比率1电价
.Fields!比率2电费 = .Fields!比率2电量 * .Fields!比率2电价
.Fields!本次电费 = .Fields!比率1电费 + .Fields!比率2电费
.Fields!合计电费 = .Fields!本次电费 + .Fields!上期余额 'IIf(IsNull(.Fields!滞纳金) = True, 0, .Fields!滞纳金)
.Fields!本期余额 = BSYE(.Fields!合计电费)
.Update
Else '是多价表正常
.Edit
'如判断本期不为空值则计算
If Val(IIf(IsNull(.Fields!本期示数) = True, 0, .Fields!本期示数)) <> 0 Then
'再判断本期值是否和上期相同,不同则计算,防止出现1度
If Val(IIf(IsNull(.Fields!本期示数) = True, 0, .Fields!本期示数)) <> Val(IIf(IsNull(.Fields!上期示数) = True, 0, .Fields!上期示数)) Then
.Fields!比率1电量 = ((IIf(IsNull(.Fields!本期示数) = True, Val(.Fields!上期示数 & ""), Val(.Fields!本期示数 & "")) - Val(IIf(IsNull(.Fields!上期示数) = True, 0, .Fields!上期示数) & "")) + .Fields!表损 + .Fields!调整电量) * IIf(.Fields!倍率 = 0, 1, .Fields!倍率) * .Fields!比率1
.Fields!比率2电量 = ((IIf(IsNull(.Fields!本期示数) = True, Val(.Fields!上期示数 & ""), Val(.Fields!本期示数 & "")) - Val(IIf(IsNull(.Fields!上期示数) = True, 0, .Fields!上期示数) & "")) + .Fields!表损 + .Fields!调整电量) * IIf(.Fields!倍率 = 0, 1, .Fields!倍率) * .Fields!比率2
.Fields!本次电量 = (.Fields!比率1电量 + .Fields!比率2电量) - .Fields!表损
.Fields!合计电量 = .Fields!本次电量 + .Fields!表损
.Fields!比率1电费 = Format(.Fields!比率1电量, "0.00") * .Fields!比率1电价
.Fields!比率2电费 = Format(.Fields!比率2电量, "0.00") * .Fields!比率2电价
.Fields!本次电费 = .Fields!比率1电费 + .Fields!比率2电费
.Fields!合计电费 = .Fields!本次电费 + .Fields!上期余额 'IIf(IsNull(.Fields!滞纳金) = True, 0, .Fields!滞纳金)
.Fields!本期余额 = BSYE(.Fields!合计电费)
.Update
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -