Office中国论坛/Access中国论坛

标题: [分享]完美解决主子窗体ADO事务更新2010版+自定义汇总条 [打印本页]

作者: wx0000888 时间: 2016-7-3 14:27
标题: [分享]完美解决主子窗体ADO事务更新2010版+自定义汇总条
本帖最后由 wx0000888 于 2016-7-5 12:14 编辑

完美解决 ACCESS2010版本主子窗体ADO事务更新+自定义汇总条

原理:

1,利用了 [适当冗余]  , 即有些查询得到的用于辅助的字段也加入到表中,只要在数据填写完整并保存的时候同时更新即可. 这样的查询语句简单,速度加快
2,利用了 ADO 事务处理, 这样可以解决临时表的问题.
3,利用了 ACCESS2007版本以上的特性, 首先查询主子窗体用DAO绑定,具有汇总功能, 修改管理主子窗体[ADO事务处理没有汇总功能]我们就创造汇总功能 , 并且这个版本以上具有隔行变色的效果.
4,利用了数组索引与控件的ColumnOrder 结合起来 ,  以及控件的ColumnHidden属性取得屏幕显示的实际控件(字段)的宽度和左右排序位置,这样就可使得汇总条随着子窗体的字段大小变动而变动,包括隐藏字段.
5,利用的 recordset.getRows(,1,字段名) 得到数组, 这样只需要在数组中处理问题,就没有了记录循环或窗体和控件的循环 ,屏幕就不会闪烁了.

用法:

首先 ,汇总条 (frmCollectBar) ,  主窗体(frmMain)就是汇总条要加入的窗体比如为,  子窗体(frmContractEdit_chd)就是与汇总一起变动的,用来输入多条数据的窗体.

在子窗体中的控件的 tag属性中, 需要在汇总的控件(字段),写上汇总字段名称, 比如子数据窗体上的控件名称为 txtQuantity , 数据源为 Quantity ,需要把这一列的所有数据汇总到汇总条上相应的控件上.  那么只要把该控件的数据源Quantity填写到 tag属性中,不要有双引号.

同理  txtPrice  的数据源为 Price 那么它的 tag 属性中写人 Price, 如果某个控件的值或数据源是相减或相加, 比如  txtUnCompletionQuantity 是由
txtQuantity-txtStockOutQuantity 这两个控件的差值得到, 且它们的数据源分别是Quantity,StockOutQuantity, 那么只需要在txtUnCompletionQuantity的tag属性中写入 Quantity,-,StockOutQuantity , 同理也不需要双引号 , 如果是相加 txtQuantity+txtStockOutQuantity  ,那么只需要在txtUnCompletionQuantity的tag属性中写入 Quantity,+,StockOutQuantity. 除此以外其他所有控件的tag属性清空.

其次, 在加汇总条的窗体的(主窗体)的OPEN事件代码中加入代码  Call frmTotalBar(Me.Name, "frmContractEdit_chd", "frmCollectBar")

最后在, 在子窗体代码事件中加入以下代码.

Private Sub Form_Click()
Call frmTotalBar(Me.Parent.Name, Me.Name, "frmCollectBar")
End Sub

另外注意汇总条(frmCollectBar) 与子窗体左对齐, 一样宽度. 汇总条定位沿顶端伸展子窗体定位向下和水平伸展.
汇总条不放在底部是因为, 子数据窗体数据写入多行后,会出现滚动条(是数据表滚动条,不是窗体滚动条,所以禁不了), 这样的话,汇总条会被滚动条隔开,毫无违和感

并附上最新附件.. ,请下载最新附件, 有描述的那个.

作者: xiaowuo2 时间: 2016-7-3 17:28
感谢分享，顶上

作者: wx0000888 时间: 2016-7-3 17:44
本帖最后由 wx0000888 于 2016-7-3 17:45 编辑

以前一直是使用的临时表,进行批量的录入, 后一直在ACCESS论坛上找能否不用临时表的办法,并且是事务处理的那种,直到看到了t小宝版主的大作,看到了希望,然后用 DAOtransform ,ADOtransform , ADObatchform 三种测试

第一种  DAOtransform  (DAO)
access2003版本或以下,好像偶尔会崩溃,溢出(估计与电脑内存大小的快慢有关)
access2010版本经常崩溃

第二种  ADObatchform  (ADO批更新)
access2003,access2010 都没有出现崩溃,但没有汇总条

第三种  ADOtransform  (ADO事务处理)  ,本人比较喜欢
access2003,access2010 都没有出现崩溃,但没有汇总条
那么能否自定义汇总条呢?  自己尝试是否得到的随着字段大小隐藏字段大小的变动而变动的这样的汇总条,结果终于成功,唯一的缺憾就是数据SUM加总是无法使用控件数据源=SUM(数量), 只能自定义一个利用窗体的 SelTop 或者利用 ADODB.RECORDSET.movenext 指针向下移动原理的函数来循环加总. 但记录指针移动屏幕会闪烁,不知有何办法更快不闪烁.

Public Sub frmTotalBar(strMain As String, strDetail As String, strBar As String)  '自定义汇总行
On Error Resume Next
Dim ctl As Control
Dim lngW As Long
Dim arrCtl() As String
Dim Index As Integer
Dim Total As Integer
Dim frm As Object
Dim frmBar As Object
Dim ctlName As String
Set frmBar = Application.Forms(strMain).Controls(strBar).Form
Set frm = Application.Forms(strMain).Controls(strDetail).Form '
ReDim arrCtl(1 To frmBar.Controls.Count)    '上标1开始
For Each ctl In frm.Controls
      If ctl.ControlType <> acLabel Then
         ctlName = ctl.Name
         If ctl.ColumnHidden = False Then
            arrCtl(ctl.ColumnOrder) = ctlName '利用数组的索引,自动排序,然后再经过后面过滤无用的,截取有用的(非隐藏的).
         End If
      End If
Next

frmBar.Box0.SetFocus             '必须转移焦点,否则无法隐藏
For Index = 1 To 20                '整理数组,有效的数组前置
      frmBar.Controls("txtControl" & Index).Visible = False
      If arrCtl(Index) <> "" Then
         Total = Total + 1
         arrCtl(Total) = arrCtl(Index)
         frmBar.Controls("txtControl" & Total).Visible = True
      End If
Next
For Index = 1 To Total             '过滤无用的,截取有用的(非隐藏的),Total是下标,1到Total位置里面都是有用的,非隐藏的
      If frm.Controls(arrCtl(Index)).ColumnWidth = -1 Then    '当新建的字段,其默认屏幕显示宽度为-1,实际是1410
         frmBar.Controls("txtControl" & Index).Width = 1410 '13.2095  (1410)
      Else
         frmBar.Controls("txtControl" & Index).Width = frm.Controls(arrCtl(Index)).ColumnWidth
      End If
      If Index = 1 Then
         frmBar.Controls("txtControl" & Index) = "汇总"       '第一列标题一般为 "汇总"
         lngW = 285                'Box的宽度作为起点(最左)
      Else
         lngW = lngW + frmBar.Controls("txtControl" & (Index - 1)).Width
      End If
      frmBar.Controls("txtControl" & Index).left = lngW
      If frm.Controls(arrCtl(Index)).Tag = "Sum" Then
         frmBar.Controls("txtControl" & Index).ControlSource = "=SumRecord(""" & strMain & """,""" & arrCtl(Index) & """)"
      End If
Next
Erase arrCtl()                   '释放内存
Set ctl = Nothing
Set frm = Nothing
Set frmBar = Nothing
End Sub

Public Function SumRecord(frmName As String, ctlName As String) As Single

Dim i As Integer
Dim lngCount As Integer
Dim frm As Form
Set frm = Forms(frmName).Controls(frmName & "_chd").Form
lngCount = frm.Form.Recordset.RecordCount ' rst.RecordCount
For i = 1 To lngCount
      frm.SelTop = i
      SumRecord = SumRecord + Nz(frm.Controls(ctlName), 0)
Next
Set frm = Nothing
End Function

作者: pyh512 时间: 2016-7-4 11:41
非常感谢！我一直在找，今天算是有解了

作者: pyh512 时间: 2016-7-4 11:50
有2003版的给个看看

作者: 风中漫步 时间: 2016-7-4 12:51
我用不上,但也谢谢分享

作者: wx0000888 时间: 2016-7-5 08:53
本帖最后由 wx0000888 于 2016-7-5 12:15 编辑

完美解决 ACCESS2010版本主子窗体ADO事务更新+自定义汇总条 , 附件本楼的与一楼的相同.

请不要重复下载. 用法见一楼

作者: pyh512 时间: 2016-7-5 11:17

wx0000888 发表于 2016-7-5 08:53
完美解决 ACCESS2010版本主子窗体ADO事务更新+自定义汇总条 , 附件本楼的与一楼的相同.

请不要重复下 ...

我根据你的做法在2007版上测试不成功，不知道问题或细节出在哪里？楼主方便做个2003版的示例可以吗？

作者: wx0000888 时间: 2016-7-5 11:34

pyh512 发表于 2016-7-5 11:17
我根据你的做法在2007版上测试不成功，不知道问题或细节出在哪里？楼主方便做个2003版的示例可以吗？

首先要按照一楼的做, 另外 Call frmTotalBar(Me.Name, "frmContractEdit_chd", "frmCollectBar") 这个函数
"frmContractEdit_chd" , 这个是我的子窗体 , 比如你的子窗体名称为 frm_chd 那么函数 Call frmTotalBar(Me.Name, "frm_chd", "frmCollectBar") 汇总条的名称和数据源都为 "frmCollectBar" ,也可改为自己的.

2003版本的没有汇总功能,因为是DAO绑定可自己加控件的在数据源写入 ="=sum(quantity)" ,如果改成2003, 估计是没问题的.

你压缩附件给我看看.

作者: wx0000888 时间: 2016-7-5 12:02
本帖最后由 wx0000888 于 2016-7-5 12:16 编辑

Public Sub frmTotalBar(strMain As String, strDetail As String, strBar As String)  '自定义汇总行
On Error Resume Next
Dim ctl As Control
Dim lngW As Long
Dim arrCtl() As String
Dim Index As Integer
Dim Total As Integer
Dim frm As Object
Dim frmBar As Object
Dim ctlName As String
Set frmBar = Application.Forms(strMain).Controls(strBar).Form
Set frm = Application.Forms(strMain).Controls(strDetail).Form '
ReDim arrCtl(1 To frmBar.Controls.Count)    '上标1开始
For Each ctl In frm.Controls
      If ctl.ControlType <> acLabel Then
         ctlName = ctl.Name
         If ctl.ColumnHidden = False Then
            arrCtl(ctl.ColumnOrder) = ctlName '利用数组的索引,自动排序,然后再经过后面过滤无用的,截取有用的(非隐藏的).
         End If
      End If
Next

frmBar.Box0.SetFocus             '必须转移焦点,否则无法隐藏
For Index = 1 To 20                '整理数组,有效的数组前置
      frmBar.Controls("txtControl" & Index).Visible = False
      If arrCtl(Index) <> "" Then
         Total = Total + 1
         arrCtl(Total) = arrCtl(Index)
         frmBar.Controls("txtControl" & Total).Visible = True
      End If
Next
For Index = 1 To Total             '过滤无用的,截取有用的(非隐藏的),Total是下标,1到Total位置里面都是有用的,非隐藏的
      If frm.Controls(arrCtl(Index)).ColumnWidth = -1 Then    '当新建的字段,其默认屏幕显示宽度为-1,实际是1410
         frmBar.Controls("txtControl" & Index).Width = 1410 '13.2095  (1410)
      Else
         frmBar.Controls("txtControl" & Index).Width = frm.Controls(arrCtl(Index)).ColumnWidth
      End If
      If Index = 1 Then
         frmBar.Controls("txtControl" & Index) = "汇总"       '第一列标题一般为 "汇总"
         lngW = 285                'Box的宽度作为起点(最左)
      Else
         lngW = lngW + frmBar.Controls("txtControl" & (Index - 1)).Width
      End If
      frmBar.Controls("txtControl" & Index).left = lngW
      If frm.Controls(arrCtl(Index)).Tag <> "" Then
         frmBar.Controls("txtControl" & Index).ControlSource = "=SumRecord(""" & strMain & """,""" & strDetail & """,""" & frm.Controls(arrCtl(Index)).Tag & """)"
         frmBar.Controls("txtControl" & Index).Format = frm.Controls(arrCtl(Index)).Format
         frmBar.Controls("txtControl" & Index).TextAlign = frm.Controls(arrCtl(Index)).TextAlign
      End If
Next
Erase arrCtl()                   '释放内存
Set ctl = Nothing
Set frm = Nothing
Set frmBar = Nothing
End Sub

Public Function SumRecord(strMain As String, strDetail As String, fldName As String) As Single
Dim i As Integer
Dim rst As New ADODB.Recordset
Dim strCalc As String          '计算符号
Dim sngVal 'As Single
Dim frm As Form
Dim arr()
Dim brr()
Set frm = Forms(strMain).Controls(strDetail).Form
Set rst = frm.Recordset
If rst.RecordCount > 0 Then
      If InStr(fldName, ",") = 0 Then
         arr = rst.GetRows(, 1, fldName) '
         For i = 0 To UBound(arr, 2)
            sngVal = sngVal + Nz(arr(0, i), 0)
         Next
      Else
         arr = rst.GetRows(, 1, Split(fldName, ",")(0))
         brr = rst.GetRows(, 1, Split(fldName, ",")(2))
         strCalc = Split(fldName, ",")(1)
         Select Case strCalc
         Case "-"
            For i = 0 To UBound(arr, 2)
                  sngVal = sngVal + (Nz(arr(0, i), 0) - Nz(brr(0, i), 0))
            Next
         Case "+"
            For i = 0 To UBound(arr, 2)
                  sngVal = sngVal + (Nz(arr(0, i), 0) + Nz(brr(0, i), 0))
            Next
         Case Else
         End Select

      End If
End If
SumRecord = sngVal
Set rst = Nothing
Set frm = Nothing
Erase arr(), brr()
End Function

替换成现在的代码试试。红色的为改动过的。       附件与一楼相同    都是代码改良过的，较通用。

作者: wx0000888 时间: 2016-7-5 20:36
补上 2003版本

作者: p51219 时间: 2016-7-7 22:14
哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈

作者: pyh512 时间: 2016-7-10 11:40

wx0000888 发表于 2016-7-5 12:02
Public Sub frmTotalBar(strMain As String, strDetail As String, strBar As String) '自定义汇总行
...

我还是老样子，会不会是版本问题或细节处理问题

作者: 飘摇王 时间: 2017-7-29 12:50
感谢分享学习学习

作者: wx0000888 时间: 2017-7-29 21:30

pyh512 发表于 2016-7-10 11:40
我还是老样子，会不会是版本问题或细节处理问题

你做个附件我看看, ADOTRANSFORM 加汇总条只是弥补 ADO绑定窗体无法合计的情况, 参考即可
另外我已经用DAOTRANSFORM 成功用于2007版本以上的 ACCESS主子批量更新. 不久就会发布

作者: su_xx 时间: 2017-8-3 16:54
学习一下，谢谢楼主

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)