设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 877|回复: 4
打印 上一主题 下一主题

[宏/菜单/工具栏] 多层数据表

[复制链接]
跳转到指定楼层
1#
发表于 2003-8-21 05:35:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
Private Sub 特征_DblClick(Cancel As Integer)
If Me.预算表序号 <= 0 Then
Exit Sub
End If
'1改变鼠标样式   将当前记录拷贝到临时表 strDRAG=TRUE
If strDRAG = False Then
Access.Screen.MousePointer = 11
Dim intI As Integer
Dim INTK As Integer
Dim intB As Long
Dim SQL1 As String

'1定义公共RST0
     Set rst0 = Me.RecordsetClone
   
     If IsNull(Me.[序号]) = True Then
     GoTo 210
      End If
      变量.rst0.Bookmark = Me.Bookmark
    '2找出当前记录的特征值
      For intI = 1 To 22
        If rst0.Fields(intI) = 0 Then
         INTK = intI - 1
         Exit For
         End If
        Next intI
           If INTK = 1 Then  '拷贝总预算 不允许
           GoTo 210
           End If
    '3  '1定义公共RSTZ
     Set 变量.rstz = CurrentDb.OpenRecordset("SELECT * FROM [11分部分项工程量清单1]")
     
      变量.rstz.FindFirst "预算表序号=" & 变量.rst0.Fields(0) & ""
      '找出当前记录的最后子记录
      Do
      intB = 变量.rstz.Fields(0)
      rstz.MoveNext
      If rstz.EOF Then
      Exit Do
      End If
      Loop Until rstz.Fields(INTK + 1) = 0
      '4向临时表追加这些记录  先清理在追加
       DoCmd.RunSQL "delete * from [11分部分项工程量清单]"
      SQL1 = "INSERT INTO [11分部分项工程量清单]  SELECT * FROM [11分部分项工程量清单1] WHERE [预算表序号]>=" & 变量.rst0.Fields(0) & " AND [预算表序号]<=" & intB
      DoCmd.RunSQL SQL1
      SQL1 = "delete * FROM [11分部分项工程量清单1] WHERE [预算表序号]>=" & 变量.rst0.Fields(0) & " AND [预算表序号]<=" & intB
      DoCmd.RunSQL SQL1
     
变量.rstz.Close
Set 变量.rstz = Nothing
210:
变量.rst0.Close
Set 变量.rst0 = Nothing

strDRAG = True
Me.Requery
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'2        改变鼠标样式   删除原来用于拷贝的记录       在当前位置插入临时表中的记录 STRDRAG=FALSE
Else
Access.Screen.MousePointer = 1
strDRAG = False
'1变量设置
   Dim rst As DAO.Recordset
   Dim lgA As Long
   Dim stra As String
   Dim strB As String
'   Dim intI As Integer
   Dim inta As Integer
'   Dim SQL1 As String
   Dim RST1 As DAO.Recordset
   Dim lgB As Long
   Dim RSTF As DAO.Recordset
   Dim intJ As Integer
'   Dim intB As Integer
   Dim blA As Boolean
   
   
   
   
   '2记录集设置

      Set rst = Me.RecordsetClone ''''''''????
      If IsNull(Me.[序号]) = True Then
      GoTo 110
      End If
      rst.Bookmark = Me.Bookmark
      lgA = rst.Fields(0)
      
      ' 记录现数据的特征值
       For intI = 1 To 22
       变量.myfield(intI) = rst.Fields(intI)
       Next intI  ' 记录现数据的特征值
       变量.myfield(55) = rst.Fields(55)
      '修改本级符号 展开
        strB = rst.Fields(23)
       If Right(strB, 1) = "?" Then
       '''''''''''''''''''''''''''''''''''''''''''
        '1定义变量
' Dim rst As DAO.Recordset
'Dim intI As Integer
'Dim INTK As Integer
'Dim intA As Integer
'Dim intB As Integer
'Dim SQL1 As String
'Dim RST1 As DAO.Recordset
Dim intM As Integer
'Dim stra As String
'Dim strB As String
Dim strC As String
'Dim lgA As Long


'2定义RST 和RST1
Set rst = Me.RecordsetClone
  If IsNull(Me.[序号]) = True Then
     GoTo 1110
     End If
rst.Bookmark = Me.Bookmark
SQL1 = "SELECT * FROM [11分部分项工程量清单1]"
Set RST1 = CurrentDb.OpenRecordset(SQL1)

'2-3 -1改变本级显示符号
If rst.Fields(23) = "?" Then
   rst.Edit
   rst.Fields(23) = "?"
   rst.Fields(54) = True
   rst.Update
   ElseIf rst.Fields(23) = "?" Then
   rst.Edit
   rst.Fields(23) = "?"
    rst.Fields(54) = True
   rst.Update
   Else
stra = Trim(rst.Fields(23))
If stra = "?" Then
stra = "?"
ElseIf stra = "?" Then
stra = "?"
End If
rst.Edit
rst.Fields(23) = Left(rst.Fields(23), Len(rst.Fields(23)) - 1) & stra
rst.Fields(54) = True
rst.Update
End If
'2-3-2找出本级的特征INTK(FIELDS(INTK)=1,FIELDS(INTK+1)=0),如果是材9, 则INTK=0)
For intI = 1 To 22
        If rst.Fields(intI) = 0 Then
         INTK = intI - 1
         Exit For
         End If
        Next intI
  '2-3-3移动RST1 排除INTK=0
     strB = "预算表序号= " & rst.Fields(0) & "
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2003-8-21 06:35:00 | 只看该作者
ok
3#
发表于 2003-8-21 21:57:00 | 只看该作者
不错的想法
4#
发表于 2003-8-22 02:05:00 | 只看该作者
用在那里,是否用在BOM分解运算里呀?
5#
 楼主| 发表于 2003-8-22 02:33:00 | 只看该作者
这是我建筑预算的数据表。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-15 20:48 , Processed in 0.097264 second(s), 28 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表