[分享]完美解决主子窗体ADO事务更新2010版+自定义汇总条

wx0000888

完美解决 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

感谢分享，顶上

wx0000888

以前一直是使用的临时表,进行批量的录入, 后一直在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

非常感谢！我一直在找，今天算是有解了

pyh512

有2003版的给个看看

风中漫步

我用不上,但也谢谢分享

wx0000888

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

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

pyh512

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

请不要重复下 ...

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

wx0000888

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

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


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