eeeee - ASP技术论坛 - 编程论坛档案馆

问题点数：0 回复次数：1

eeeee

Option Explicit
Dim strUnitMilter, strPubMilter As String
Dim strUnitPeriod, strPubPeriod As String
Dim strLG As String
Dim Preview As Boolean
Dim bolEdit As Boolean
Dim strwhere As String
Public xsws As Integer
Public strmsg As String
Dim strpre As String

Private Sub consize()
On Error Resume Next

MilterTab.Top = CoolBar1.Height
MilterTab.Height = ScaleHeight - CoolBar1.Height
MilterTab.width = ScaleWidth
MilterTab.left = 0
unitgrid.width = ScaleWidth - 2 * unitgrid.left ' * unitgrid.left
unitgrid.Height = MilterTab.Height - unitgrid.left - unitgrid.Top '- MilterTab.TabHeight

End Sub

Private Sub waitfresh()
If unitgrid.Rows = 1 Then Exit Sub
unitgrid.Cell(flexcpForeColor, 1, 0, unitgrid.Rows - 1, unitgrid.Cols - 1) = &H8000000F
End Sub

Private Sub cbolg_Click()
If CboLG.ListIndex < 0 Then Exit Sub
Dim adoTmp As ADODB.Recordset, s1 As String, s2 As String
If CboLG.ListIndex >= 0 Then
If CboLG.Text <> "<全部>" Then
s2 = " 楼阁编号='" & GetValue(CboLG.Text) & "'"
Else
s2 = ""
End If
End If
If Trim(s2) <> "" Then
Set adoTmp = mycns.execute("select distinct 梯数 from 单元 where " & s2 & " order by 梯数")
addlist adoTmp, Combo1, "梯数", "", True
Set adoTmp = mycns.execute("select distinct 楼层名称, 楼层 from 单元 where " & s2 & " order by 楼层")
addlist adoTmp, Combo2, "楼层名称", "楼层", True

End If

waitfresh
' makewhere
End Sub

Private Sub cbolp_Click()
On Error GoTo e:
Dim adoTmp As New ADODB.Recordset
CboLG.Clear
CboLG.AddItem "<全部>"

adoTmp.Open "select 楼盘名称,楼阁名称,楼阁.楼盘编号,楼阁编号 from 楼阁,楼盘 where 楼盘.楼盘编号=楼阁.楼盘编号 " & IIf(cbolp.Text = "<全部>", "", " and 楼盘.楼盘编号='" & GetValue(cbolp.Text) & "' ") & " order by 楼阁.楼阁编号", mycns
Do While Not adoTmp.eof
CboLG.AddItem adoTmp!楼盘名称 & "_" & adoTmp!楼阁名称 & "(" & adoTmp!楼阁编号 & ")"
adoTmp.MoveNext
Loop
adoTmp.Close
Set adoTmp = Nothing
If CboLG.ListCount > 0 Then CboLG.ListIndex = 0
Exit Sub
e: MsgBox Err.Description, vbInformation + vbOKOnly, soft
End Sub

Private Sub CbounitMilter_Click()
If CboUnitMilter.ListIndex < 0 Then Exit Sub
'CboUnitMilter = Trim(CboUnitMilter)
waitfresh
' makewhere
End Sub

Private Sub CboPubMilter_Click()
' CboPubMilter = Trim(CboPubMilter)
makewhere
End Sub
'Private Sub CboPubPeriod_click()
' makewhere
'End Sub

Private Sub CboUnitPeriod_Click()
If CboUnitPeriod.ListIndex < 0 Then Exit Sub
waitfresh
If pubgrid.Rows > 1 Then pubgrid.Cell(flexcpForeColor, 1, 0, pubgrid.Rows - 1, pubgrid.Cols - 1) = &H8000000F

' makewhere
End Sub

Function GetValue(strSource) As String
Dim i As Integer
Dim StrName As String
If Trim(strSource) = "" Then
GetValue = ""
Exit Function
End If
i = InStr(1, strSource, "(") + 1
StrName = Mid(strSource, i)
GetValue = left(StrName, Len(StrName) - 1)
End Function

Sub makewhere(Optional fshow As Boolean = True)
Screen.MousePointer = 11
Dim adoTmp As New ADODB.Recordset
Dim Scrow As Integer, bcrow As Integer

Dim i As Integer

strwhere = " 0=0 "
If MilterTab.Tab = 0 Then 'And CboPubMilter.ListIndex <> -1
unitgrid.Redraw = False
strwhere = strwhere & " and 抄表终止日期='" & CboUnitPeriod.Text & "'"
' strpre = strpre & " and 抄表终止日期='" &
If CboUnitMilter.ItemData(CboUnitMilter.ListIndex) <> -1 And CboUnitMilter.ListIndex > 0 Then
If CboUnitMilter.ItemData(CboUnitMilter.ListIndex) = 0 Then strwhere = strwhere & " and view单元表抄表.表名称='" & Trim(CboUnitMilter) & "'"
If CboUnitMilter.ItemData(CboUnitMilter.ListIndex) = 1 Then strwhere = strwhere & " and 种类='" & Trim(CboUnitMilter) & "'"
End If
' If CboLG.ListIndex <> 0 And CboPubMilter.ListIndex <> -1 Then

' End If
If CboLG.ListIndex < 0 And CboLG.ListCount > 0 Then CboLG.ListIndex = 0

If cbolp.Text <> "<全部>" Then
strwhere = strwhere & " and 楼盘编号='" & GetValue(cbolp.Text) & "'"
End If

If CboLG.Text <> "<全部>" Then
strwhere = strwhere & " and 楼阁编号='" & GetValue(CboLG.Text) & "'"
End If

If Trim(Combo1) <> "" And Trim(Combo1) <> "全部" Then
strwhere = strwhere & " and 梯数=" & Combo1
End If
If Trim(Combo2) <> "" And Trim(Combo2) <> "全部" Then
strwhere = strwhere & " and 楼层=" & Combo2.ItemData(Combo2.ListIndex)
End If

If fshow = False Then strwhere = " 1=0"
adoTmp.CursorLocation = adUseClient
adoTmp.Open "select v.单元编号, 表名称,楼阁名称,楼层名称,单元名称,住户名称,单元编号,上次读数,本次读数,tt.上月行度,行度,倍率,计费标志,备注,抄表终止日期,id,量程,种类,最低用量,最高用量 from view单元表抄表 AS v join (select 单元编号,行度 from 单元表抄表 where" & strpre & " ) AS tt on tt.单元编号 = v.单元编号 where " & strwhere & " order by 楼阁编号,楼层,单元名称,种类,表名称,抄表终止日期", mycns, adOpenDynamic, adLockOptimistic
Set Adodc1.Recordset = adoTmp.Clone
' UnitGrid.DataRefresh
unitgrid.FormatString = "表名称 | 楼阁名称 |楼层 |单元名称 |住户名称 |单元编号 | 上次读数 | 本次读数 | 行度 | 倍率| 计费标志| 备注 |抄表终止日期|id| 量程 |种类 |最低用量| 最高用量 "
For i = 0 To unitgrid.Cols - 1
If unitgrid.Cell(flexcpText, 0, i) = "上次读数" Or unitgrid.Cell(flexcpText, 0, i) = "本次读数" Or unitgrid.Cell(flexcpText, 0, i) = "行度" Then unitgrid.ColFormat(i) = "#"
Next
unitgrid.AutoSize 0, unitgrid.Cols - 1
unitgrid.RowHeight(-1) = 300
unitgrid.Redraw = True
'===================================
Scrow = FindCol(unitgrid, "上次读数")
bcrow = FindCol(unitgrid, "本次读数")
For i = 1 To unitgrid.Rows - 1
If unitgrid.ValueMatrix(i, Scrow) > unitgrid.ValueMatrix(i, bcrow) Then

unitgrid.Cell(flexcpBackColor, i, 0, i, 11) = &HC0C0FF

End If
Next
'---------------------

If GetSetting(RstySoftwareVersion, "抄表管理", "填充", "0") = "1" Then
For i = 1 To unitgrid.Rows - 1
If unitgrid.ValueMatrix(i, 6) = unitgrid.ValueMatrix(i, 7) Then
unitgrid.TextMatrix(i, 7) = ""
unitgrid.TextMatrix(i, 8) = ""
End If
Next
End If
unitgrid.Subtotal flexSTClear
unitgrid.Subtotal flexSTSum, -1, 8, "9", &H80000018, , True, "合计"

Else
pubgrid.Redraw = False
strwhere = strwhere & " and 抄表终止日期='" & CboUnitPeriod.Text & "'"
If CboPubMilter.ItemData(CboPubMilter.ListIndex) <> -1 And CboPubMilter.ListIndex > 0 Then
If CboPubMilter.ItemData(CboPubMilter.ListIndex) = 0 Then strwhere = strwhere & " and 表名称='" & Trim(CboPubMilter) & "'"
If CboPubMilter.ItemData(CboPubMilter.ListIndex) = 1 Then strwhere = strwhere & " and 种类='" & Trim(CboPubMilter) & "'"
End If
adoTmp.CursorLocation = adUseClient
adoTmp.Open "select 表名称,上次读数,本次读数,行度,倍率,计费标志,备注,抄表终止日期,id,量程,种类 from view公用表抄表 where " & strwhere & " order by 抄表终止日期,种类,表名称", mycns, adOpenDynamic, adLockOptimistic
Set Adodc2.Recordset = adoTmp.Clone
'PubGrid.DataRefresh
pubgrid.Subtotal flexSTClear
pubgrid.SubtotalPosition = flexSTAbove
' PubGrid.Subtotal flexSTSum, -1, 3, "9", &HC0FFC0, , True, "合计"
' PubGrid.autosize 0, PubGrid.cols - 1, , 100
pubgrid.RowHeight(-1) = 300
For i = 0 To pubgrid.Cols - 1
If pubgrid.Cell(flexcpText, 0, i) = "上次读数" Or pubgrid.Cell(flexcpText, 0, i) = "本次读数" Or pubgrid.Cell(flexcpText, 0, i) = "行度" Then pubgrid.ColFormat(i) = "#.####"
Next
'==========================
Scrow = FindCol(pubgrid, "上次读数")
bcrow = FindCol(pubgrid, "本次读数")

For i = 1 To pubgrid.Rows - 1
If pubgrid.ValueMatrix(i, Scrow) > pubgrid.ValueMatrix(i, bcrow) Then

pubgrid.Cell(flexcpBackColor, i, 0, i, pubgrid.Cols - 1) = &HC0C0FF

End If
Next
'---------------

If GetSetting(RstySoftwareVersion, "抄表管理", "填充", "0") = "1" Then

For i = 1 To pubgrid.Rows - 1
If pubgrid.ValueMatrix(i, 1) = pubgrid.ValueMatrix(i, 2) Then
pubgrid.TextMatrix(i, 2) = ""
pubgrid.TextMatrix(i, 3) = ""
End If
Next
End If
pubgrid.Redraw = True

End If
FormatGrid
Screen.MousePointer = 0

End Sub

Private Sub CboUnitPeriod_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub Form_Activate()
consize
End Sub

Private Sub Form_Load()
On Error Resume Next

Set tmp = Nothing
MilterTab.Tab = 1
If CboPubMilter.ListCount > 0 Then CboPubMilter.ListIndex = 0
If CboLG.ListCount > 0 Then CboLG.ListIndex = 0
MilterTab.Tab = 0
If CboUnitPeriod.ListCount > 0 Then CboUnitPeriod.ListIndex = 0
If CboUnitMilter.ListCount > 0 Then CboUnitMilter.ListIndex = 0

makewhere False
FormatGrid
If GetSetting(RstyCompanyName, RstySoftwareVersion, "自动帮助", "1") = "1" Then
Toolbar1_ButtonClick Toolbar1.Buttons("帮助")
End If

Me.Refresh

'检查权限 Me

Exit Sub
e: MsgBox Err.Description, vbInformation + vbOKOnly, soft
End Sub

Sub setCbo()
Dim adoTmp As New ADODB.Recordset
CboUnitMilter.Clear
CboPubMilter.Clear
CboUnitPeriod.Clear
' CboPubPeriod.Clear
cbolp.Clear
cbolp.AddItem "<全部>"
adoTmp.Open "select 楼盘名称,楼盘编号 from 楼盘 ", mycns
Do While Not adoTmp.eof
cbolp.AddItem adoTmp!楼盘名称 & "(" & adoTmp!楼盘编号 & ")"
adoTmp.MoveNext
Loop
adoTmp.Close

Set adoTmp = Nothing
If cbolp.ListCount > 0 Then cbolp.ListIndex = 0
CboLG.Clear
CboLG.AddItem "<全部>"
adoTmp.Open "select 楼盘名称,楼阁名称,楼阁.楼盘编号,楼阁编号 from 楼阁,楼盘 where 楼盘.楼盘编号=楼阁.楼盘编号 order by 楼阁.楼阁编号", mycns
Do While Not adoTmp.eof
CboLG.AddItem adoTmp!楼盘名称 & "_" & adoTmp!楼阁名称 & "(" & adoTmp!楼阁编号 & ")"
adoTmp.MoveNext
Loop
adoTmp.Close
Set adoTmp = Nothing
If CboLG.ListCount > 0 Then CboLG.ListIndex = 0

adoTmp.Open "select distinct 表名称 from 费表 where 表类型='单元表' ", mycns
CboUnitMilter.AddItem "<全部>"
CboUnitMilter.ItemData(CboUnitMilter.NewIndex) = -1
CboUnitMilter.AddItem "----按表名筛选----"
CboUnitMilter.ItemData(CboUnitMilter.NewIndex) = -1

Do While Not adoTmp.eof
CboUnitMilter.AddItem " " & adoTmp!表名称
CboUnitMilter.ItemData(CboUnitMilter.NewIndex) = 0

adoTmp.MoveNext
Loop
CboUnitMilter.AddItem "----按种类筛选----"
CboUnitMilter.ItemData(CboUnitMilter.NewIndex) = -1
CboUnitMilter.AddItem " 电表"
CboUnitMilter.ItemData(CboUnitMilter.NewIndex) = 1
CboUnitMilter.AddItem " 水表"
CboUnitMilter.ItemData(CboUnitMilter.NewIndex) = 1
CboUnitMilter.AddItem " 煤气表"
CboUnitMilter.ItemData(CboUnitMilter.NewIndex) = 1
CboUnitMilter.AddItem " 其它"
CboUnitMilter.ItemData(CboUnitMilter.NewIndex) = 1

adoTmp.Close
Set adoTmp = Nothing
adoTmp.Open "select distinct 表名称 from 费表 where 表类型='公用表' or 表类型='总表' ", mycns
CboPubMilter.AddItem "<全部>"
CboPubMilter.ItemData(CboPubMilter.NewIndex) = -1
CboPubMilter.AddItem "------按表名筛选------"
CboPubMilter.ItemData(CboPubMilter.NewIndex) = -1

Do While Not adoTmp.eof
CboPubMilter.AddItem " " & adoTmp!表名称
CboPubMilter.ItemData(CboPubMilter.NewIndex) = 0
adoTmp.MoveNext
Loop
CboPubMilter.AddItem "------按种类筛选------"
CboPubMilter.ItemData(CboPubMilter.NewIndex) = -1
CboPubMilter.AddItem " 电表"
CboPubMilter.ItemData(CboPubMilter.NewIndex) = 1
CboPubMilter.AddItem " 水表"
CboPubMilter.ItemData(CboPubMilter.NewIndex) = 1
CboPubMilter.AddItem " 煤气表"
CboPubMilter.ItemData(CboPubMilter.NewIndex) = 1
CboPubMilter.AddItem " 其它"
CboPubMilter.ItemData(CboPubMilter.NewIndex) = 1
adoTmp.Close
Set adoTmp = Nothing

adoTmp.Open "select distinct 抄表终止日期 from 单元表抄表 where 抄表终止日期<>'<当前抄表期间>' order by 抄表终止日期 desc ", mycns
CboUnitPeriod.AddItem "<当前抄表期间>"
Do While Not adoTmp.eof
CboUnitPeriod.AddItem adoTmp!抄表终止日期
adoTmp.MoveNext
Loop
adoTmp.Close
Set adoTmp = Nothing
End Sub

Private Sub Form_Resize()
consize
End Sub

Private Sub Form_Unload(Cancel As Integer)
Hide
unloadform
End Sub

Sub SaveDisk(obj As Object)
End Sub

Function FindCol(obj As Object, strCol) As Integer
Dim i As Integer
With obj
For i = 0 To .Cols - 1
If Trim(.TextMatrix(0, i)) = strCol Then
FindCol = i
Exit For
End If
Next
End With
End Function

Sub FormatGrid()
On Error Resume Next
Dim i As Integer, strformat
With unitgrid
.ColAlignment(3) = flexAlignLeftCenter
.ColAlignment(5) = flexAlignLeftCenter
.ColDataType(6) = flexDTSingle
' .ColDataType(7) = flexDTCurrency
Select Case xsws
Case 0
strformat = "#"
Case 1
strformat = "#.0"
Case 2
strformat = "#.00"
Case 3
strformat = "#.000"
Case 4
strformat = "#.0000"
End Select
.ColFormat(8) = strformat
.ColFormat(6) = strformat
.ColFormat(7) = strformat

.ColWidth(14) = 0
.ColWidth(12) = 0
.ColWidth(13) = 0
.ColWidth(15) = 0
.ColHidden(16) = True
.ColHidden(17) = True
.ColHidden(.Cols - 4) = False
.ColWidth(.Cols - 4) = 1200
End With
With pubgrid
' .ColFormat(2) = "#"
' .ColFormat(3) = "#"
' .ColFormat(4) = "#"

.ColWidth(7) = 0
.ColWidth(8) = 0
' .ColWidth(9) = 0
.ColWidth(10) = 0
End With
更改命名 unitgrid

End Sub

Private Sub m_about_Click()
'frmAbout.Show vbModal
End Sub

Private Sub m_billedit_Click()
Frm单据选项.Combo1.Clear
Frm单据选项.Combo1.AddItem "用户抄表清单", 0
Frm单据选项.Combo1.AddItem "单元表抄表清单", 1
Frm单据选项.Combo1.AddItem "公用表抄表清单", 2
Frm单据选项.Combo1.ListIndex = 0
Frm单据选项.Show 1
End Sub

Private Sub m_contains_Click()
Dim nRet As Integer

'如果这个工程没有帮助文件，显示消息给用户
'可以在“工程属性”对话框中为应用程序设置帮助文件
' If Len(App.HelpFile) = 0 Then
' MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
' Else
' On Error Resume Next
' nRet = OSWinHelp(Me.hWnd, App.HelpFile, 3, 0)
' If Err Then
' MsgBox Err.Description
' End If
' End If

End Sub

Private Sub m_pubpreview_Click()
打印 False, "公用表抄表清单"
End Sub

Private Sub m_pubprint_Click()
打印 True, "公用表抄表清单"
End Sub

Private Sub m_unitpreview_Click()
打印 False, "单元表抄表清单"
End Sub

Private Sub m_unitprint_Click()
打印 True, "单元表抄表清单"
End Sub

Private Sub MilterTab_Click(PreviousTab As Integer)
If MilterTab.Tab = 1 Then
pubgrid.width = ScaleWidth - 2 * pubgrid.left ' * unitgrid.left
pubgrid.Height = MilterTab.Height - pubgrid.left - pubgrid.Top '- MilterTab.TabHeight
mnu_重新计算用量.Enabled = False
Else
mnu_重新计算用量.Enabled = True
End If
End Sub

Private Sub mnu_导出单元表_Click()
On Error GoTo e:
Dim tmp As New ADODB.Recordset
Dim flname As String

If Trim(CboUnitPeriod.Text) = "<当前抄表期间>" Then
MsgBox "当前抄表期间的抄表记录不能导出，请先结束抄表！", vbInformation + vbOKOnly, soft
Exit Sub
End If

If MsgBox("是否将抄表期间为：" & Trim(CboUnitPeriod.Text) & " 的单元表抄表记录导出？", vbYesNo + vbQuestion, soft) = vbYes Then

tmp.CursorLocation = adUseClient
tmp.Open "select * from 单元表抄表 where 抄表终止日期='" & Trim(CboUnitPeriod.Text) & "'", mycns, adOpenDynamic, adLockOptimistic
Set adoport.Recordset = tmp.Clone
tmp.Clone: Set tmp = Nothing
cmdlg.CancelError = True
cmdlg.filter = "(倍思特表格文件)*.rgd|*.rgd"
cmdlg.ShowSave
flname = cmdlg.FileName
If flname <> "" Then
grid.SaveGrid flname, flexFileAll
End If
End If
Exit Sub
e: If Err.Number = 32755 Then Exit Sub
MsgBox Err.Description, vbInformation + vbOKOnly, soft
End Sub

Private Sub mnu_导出公用表_Click()
On Error GoTo e:
Dim tmp As New ADODB.Recordset
Dim flname As String

If Trim(CboUnitPeriod.Text) = "<当前抄表期间>" Then
MsgBox "当前抄表期间的抄表记录不能导出，请先结束抄表！", vbInformation + vbOKOnly, soft
Exit Sub
End If

''导出公用表抄表记录
If MsgBox("是否将抄表期间为：" & Trim(CboUnitPeriod.Text) & " 的公用表抄表记录导出？", vbYesNo + vbQuestion, soft) = vbYes Then

tmp.CursorLocation = adUseClient
tmp.Open "select * from 公用表抄表 where 抄表终止日期='" & Trim(CboUnitPeriod.Text) & "'", mycns, adOpenDynamic, adLockOptimistic
Set adoport.Recordset = tmp.Clone
tmp.Clone: Set tmp = Nothing
cmdlg.CancelError = True
cmdlg.filter = "(倍思特表格文件)*.rgd|*.rgd"
cmdlg.ShowSave
flname = cmdlg.FileName
If flname <> "" Then
grid.SaveGrid flname, flexFileAll
End If
End If

Exit Sub
e: If Err.Number = 32755 Then Exit Sub
MsgBox Err.Description, vbInformation + vbOKOnly, soft
End Sub

Private Sub mnu_导入单元表_Click()
On Error GoTo e:
Dim flname As String
Dim tmp As New ADODB.Recordset
Dim i As Long
Dim c As Integer
Dim f As Integer
Dim tmpdq As New ADODB.Recordset
cmdlg.CancelError = True
cmdlg.filter = "(倍思特表格文件)*.rgd|*.rgd"
cmdlg.ShowOpen
flname = cmdlg.FileName
grid.LoadGrid flname, flexFileAll
If grid.Rows <= 1 Then
MsgBox "该文件中没有数据！", vbInformation + vbOKOnly, soft
Exit Sub
End If
tmp.CursorLocation = adUseClient
tmpdq.CursorLocation = adUseClient
If MsgBox("是否将文件：" & flname & "中的抄表数据导入到数据库中？", vbQuestion + vbYesNo, soft) = vbYes Then

For i = 0 To grid.Cols - 1
If Trim(grid.Cell(flexcpText, 0, i)) = "抄表终止日期" Then
tmp.Open "select * from 单元表抄表 where 抄表终止日期='" & Trim(grid.Cell(flexcpText, 1, i)) & "'", mycns, adOpenDynamic, adLockOptimistic
Exit For
End If
Next
If Not tmp.eof Then
If MsgBox("抄表期间为：" & tmp!抄表终止日期 & "的数据已经存在,是否覆盖？", vbQuestion + vbYesNo, soft) = vbNo Then
tmp.Close: Set tmp = Nothing
Exit Sub
Else
mycns.execute "delete from 单元表抄表 where 抄表终止日期='" & Trim(tmp!抄表终止日期) & "'"

End If
End If
mycns.execute "delete from 单元表抄表 where 抄表终止日期='<当前抄表期间>'"
tmpdq.Open "select * from 单元表抄表 where 1=0", mycns, adOpenDynamic, adLockOptimistic
Me.MousePointer = 11
For i = 1 To grid.Rows - 1
tmp.AddNew
For c = 0 To grid.Cols - 1
If UCase(Trim(grid.Cell(flexcpText, 0, c))) <> "ID" Then
If Trim(grid.Cell(flexcpText, i, c)) <> "" Then
tmp(Trim(grid.Cell(flexcpText, 0, c))) = Trim(grid.Cell(flexcpText, i, c))
Else
If Trim(grid.Cell(flexcpText, 0, c)) = "编号" Or Trim(grid.Cell(flexcpText, 0, c)) = "父表" Or Trim(grid.Cell(flexcpText, 0, c)) = "备注" Then
tmp(Trim(grid.Cell(flexcpText, 0, c))) = " "
Else
tmp(Trim(grid.Cell(flexcpText, 0, c))) = 0
End If
End If
End If
Next
tmp.MoveLast
tmpdq.AddNew
For f = 0 To tmpdq.Fields.Count - 1
If UCase(tmpdq.Fields(f).Name) <> "ID" Then
tmpdq.Fields(f) = tmp.Fields(f)
End If
Next
tmpdq!上次读数 = tmp!本次读数
tmpdq!行度 = 0
tmpdq!抄表终止日期 = "<当前抄表期间>"
tmpdq.MoveLast
Next
tmp.Close: Set tmp = Nothing
tmpdq.Close: Set tmpdq = Nothing

MsgBox "数据导入完毕！", vbInformation + vbOKOnly, soft
Me.MousePointer = 0

End If
CboUnitPeriod.Clear
tmp.Open "select distinct 抄表终止日期 from 单元表抄表 where 抄表终止日期<>'<当前抄表期间>' order by 抄表终止日期 desc ", mycns
CboUnitPeriod.AddItem "<当前抄表期间>"
Do While Not tmp.eof
CboUnitPeriod.AddItem tmp!抄表终止日期
tmp.MoveNext
Loop
tmp.Close
Set tmp = Nothing
If CboUnitPeriod.ListCount > 0 Then CboUnitPeriod.ListIndex = 0

Exit Sub
e: If Err.Number = 32755 Then Exit Sub
If Err.Number = 3265 Then
MsgBox "文件中的数据不正确,请检查文件是否正确！", vbInformation + vbOKOnly, soft
Me.MousePointer = 0
Else
MsgBox Err.Description, vbInformation + vbOKOnly, soft
Me.MousePointer = 0
End If
End Sub

Private Sub mnu_导入单元表XLS_Click()
On Error GoTo e:

Dim flname As String
Dim tmp As New ADODB.Recordset
Dim cn As New Connection
Dim strf As String
If Trim(CboUnitPeriod) <> "<当前抄表期间>" Then
MsgBox "导入公用表读数必需选择<当前抄表期间>！", vbInformation + vbOKOnly, soft
Exit Sub
End If

cmdlg.CancelError = True
cmdlg.filter = "(EXCEL文件)*.XLS|*.XLS"
cmdlg.ShowOpen
flname = cmdlg.FileName
If flname <> "" Then

cn.Open "Provider=MSDASQL.1;Persist Security Info=False;User ID=ADMIN;Data Source=Excel Files;Initial Catalog=" & flname
Set tmp = cn.execute("select * from [sheet1$] ")
Do While Not tmp.eof
If Not IsNull(tmp!单元编号) Then
mycns.execute "update 单元表抄表 set 本次读数=" & CStr(tmp!本次读数) & ",行度=" & CStr(tmp!行度) & " where 单元编号='" & Trim(tmp!单元编号) & "' and 表名称='" & Trim(tmp!表名称) & "' and 抄表终止日期='<当前抄表期间>'"
End If
tmp.MoveNext
Loop

Set tmp = Nothing
Set cn = Nothing

End If
MsgBox "导入完毕！", vbInformation + vbOKOnly, soft
makewhere True
Exit Sub
e: If Err.Number = 32755 Then Exit Sub
MsgBox Err.Description, vbInformation + vbOKOnly, soft
End Sub

Private Sub mnu_导入公用表_Click()
On Error GoTo e:
Dim flname As String
Dim tmp As New ADODB.Recordset
Dim i As Long
Dim c As Integer
Dim f As Integer
Dim tmpdq As New ADODB.Recordset
cmdlg.CancelError = True
cmdlg.filter = "(倍思特表格文件)*.rgd|*.rgd"
cmdlg.ShowOpen
flname = cmdlg.FileName
grid.LoadGrid flname, flexFileAll
If grid.Rows <= 1 Then
MsgBox "该文件中没有数据！", vbInformation + vbOKOnly, soft
Exit Sub
End If
tmp.CursorLocation = adUseClient
tmpdq.CursorLocation = adUseClient
If MsgBox("是否将文件：" & flname & "中的抄表数据导入到数据库中？", vbQuestion + vbYesNo, soft) = vbYes Then

For i = 0 To grid.Cols - 1
If Trim(grid.Cell(flexcpText, 0, i)) = "抄表终止日期" Then
tmp.Open "select * from 公用表抄表 where 抄表终止日期='" & Trim(grid.Cell(flexcpText, 1, i)) & "'", mycns, adOpenDynamic, adLockOptimistic
Exit For
End If
Next
If Not tmp.eof Then
If MsgBox("抄表期间为：" & tmp!抄表终止日期 & "的数据已经存在,是否覆盖？", vbQuestion + vbYesNo, soft) = vbNo Then
tmp.Close: Set tmp = Nothing
Exit Sub
Else
mycns.execute "delete from 公用表抄表 where 抄表终止日期='" & Trim(tmp!抄表终止日期) & "'"
' tmp.Requery
End If

End If
mycns.execute "delete from 公用表抄表 where 抄表终止日期='<当前抄表期间>'"
tmpdq.Open "select * from 公用表抄表 where 1=0", mycns, adOpenDynamic, adLockOptimistic
Me.MousePointer = 11
For i = 1 To grid.Rows - 1
tmp.AddNew
For c = 0 To grid.Cols - 1
If UCase(Trim(grid.Cell(flexcpText, 0, c))) <> "ID" Then
If Trim(grid.Cell(flexcpText, i, c)) <> "" Then
tmp(Trim(grid.Cell(flexcpText, 0, c))) = Trim(grid.Cell(flexcpText, i, c))
Else
If Trim(grid.Cell(flexcpText, 0, c)) = "编号" Or Trim(grid.Cell(flexcpText, 0, c)) = "父表" Or Trim(grid.Cell(flexcpText, 0, c)) = "备注" Then
tmp(Trim(grid.Cell(flexcpText, 0, c))) = " "
Else
tmp(Trim(grid.Cell(flexcpText, 0, c))) = 0
End If
End If
End If
Next
tmp.MoveLast

tmpdq.AddNew
For f = 0 To tmpdq.Fields.Count - 1
If UCase(tmpdq.Fields(f).Name) <> "ID" Then
tmpdq.Fields(f) = tmp.Fields(f)
End If
Next
tmpdq!上次读数 = tmp!本次读数
tmpdq!行度 = 0
tmpdq!抄表终止日期 = "<当前抄表期间>"
tmpdq.MoveLast

Next
tmp.Close: Set tmp = Nothing
tmpdq.Close: Set tmpdq = Nothing

MsgBox "数据导入完毕！", vbInformation + vbOKOnly, soft
Me.MousePointer = 0

Private Sub mnu_导入公用表XLS_Click()
On Error GoTo e:

Dim flname As String
Dim tmp As New ADODB.Recordset
Dim cn As New Connection
Dim strf As String

If Trim(CboUnitPeriod) <> "<当前抄表期间>" Then
MsgBox "导入公用表读数必需选择<当前抄表期间>！", vbInformation + vbOKOnly, soft
Exit Sub
End If

cmdlg.CancelError = True
cmdlg.filter = "(EXCEL文件)*.XLS|*.XLS"
cmdlg.ShowOpen
flname = cmdlg.FileName
If flname <> "" Then

cn.Open "Provider=MSDASQL.1;Persist Security Info=False;User ID=ADMIN;Data Source=Excel Files;Initial Catalog=" & flname
Set tmp = cn.execute("select * from [sheet1$] ")
Do While Not tmp.eof
mycns.execute "update 公用表抄表 set 本次读数=" & CStr(tmp!本次读数) & ",行度=" & CStr(tmp!行度) & " where 表名称='" & Trim(tmp!表名称) & "' and 抄表终止日期='<当前抄表期间>'"
tmp.MoveNext
Loop

Set tmp = Nothing
Set cn = Nothing

End If
MsgBox "导入完毕！", vbInformation + vbOKOnly, soft
makewhere True
Exit Sub
e: If Err.Number = 32755 Then Exit Sub
MsgBox Err.Description, vbInformation + vbOKOnly, soft
End Sub

Private Sub mnu_选项_Click()
On Error GoTo e
frm抄表选项.Show 1
Me.Refresh
Exit Sub
e:
MsgBox Err.Description, vbInformation, soft
End Sub

Private Sub mnu_重新计算用量_Click()
On Error GoTo e:
mycns.execute "update 单元表抄表 set 行度=本次读数-上次读数 where 抄表终止日期='" & Trim(CboUnitPeriod.Text) & "'"
If 最低用量 = 2 Then
mycns.execute "update 单元表抄表 set 行度=最低用量 where 最低用量>0 and 行度<最低用量 and 抄表终止日期='" & Trim(CboUnitPeriod.Text) & "'"
End If
If 最高用量 = 2 Then
mycns.execute "update 单元表抄表 set 行度=最高用量 where 最高用量>0 and 行度>最高用量 and 抄表终止日期='" & Trim(CboUnitPeriod.Text) & "'"
End If
MsgBox "成功地重新计算了用量！", vbInformation, soft
Adodc1.Recordset.Requery
Exit Sub
e: MsgBox Err.Description, vbInformation + vbOKOnly, soft

End Sub

搜索更多相关主题的帖子: eeeee　