Access交流中心

北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |

从子窗体1中选中某一条记录双击后添加到子窗体2中后无法保存

kongkong  发表于:2018-04-17 14:45:31  
复制

各位大神,现在遇到一个问题,就是我想要从子窗体1中选定其中一条记录,双击产品ID后添加到子窗体2中,添加成功了,但是发现无法保存,现附上附件,求助各位大神,感激不尽。


子窗体1双击代码如下:

Option Compare Database

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    顶行 = Me.SelTop
    行数 = Me.SelHeight
End Sub

Private Sub 合同ID_DblClick(Cancel As Integer)
    Call llx
End Sub

Private Sub 产品ID_DblClick(Cancel As Integer)
    Call llx
End Sub

Private Sub 产品名称_DblClick(Cancel As Integer)
    Call llx
End Sub

Sub llx()
    SQLSTR = "insert into TMP_产品入厂明细表(合同ID, 产品ID, 产品名称, 规格型号, 单位, 单价) SELECT 合同ID, 产品ID, 产品名称, 规格型号, 单位, 单价 FROM TMP_RC_产品入厂明细表 WHERE 产品ID = '" & Me.产品ID & "'"

    DoCmd.SetWarnings False              ' 取消系统提示
    DoCmd.RunSQL SQLSTR            ' 运行查询
    DoCmd.SetWarnings True                ' 恢复系统提示

    Me.Parent.sfrDetail.Form.Requery
End Sub


 

Top
kongkong 发表于:2018-04-17 14:46:03


kongkong 发表于:2018-04-17 14:46:45


kongkong 发表于:2018-04-17 14:47:53
Option Compare Database
Option Explicit
Private mclsSC客户ID As New SearchComboBox '声明一个组合框动态筛选类并将其实例化


Public Function InitData()
    ClearControlValues Me
    CurrentDb.Execute "DELETE FROM [TMP_产品入厂明细表]"
    Me.sfrDetail.Requery
End Function








Private Sub Form_Current()
If Nz(Me![入厂ID]) = "" Then Me![入厂ID] = GetAutoNumber("入厂ID")
End Sub


Private Sub Form_Load()
 On Error GoTo ErrorHandler
    Dim strSQL        As String
    Dim cnn           As Object 'ADODB.Connection
    Dim rst           As Object 'ADODB.Recordset
    Dim rstTmp        As Object 'DAO.Recordset
    ApplyTheme Me


    CurrentDb.Execute "DELETE FROM [TMP_产品入厂明细表]"
    CurrentDb.Execute "DELETE FROM [TMP_RC_产品入厂明细表]"
    
    If IsNull(Me.OpenArgs) Then
        Me.DataEntry = True
    End If
     
mclsSC客户ID.Init Combo:=Me.客户ID, _
                    SearchField:="客户名称  & 所属事业部", _
                    SQLSELECT:="客户ID, 客户名称, 所属事业部", _
                    SQLFROM:="客户信息表", _
                    SQLWHERE:="客户ID", _
                    SQLORDERBY:="所属事业部"
 If Me.DataEntry Then
    
       Me.客户ID.SetFocus
       Me.sfrDetail.Requery
        Exit Sub
        End If


    Me.btnSave.Enabled = Me.AllowEdits


    Set cnn = CurrentProject.Connection
    
    strSQL = "SELECT * FROM [产品入厂表] WHERE [入厂ID]=" & SQLText(Me.OpenArgs)
    Set rst = OpenADORecordset(strSQL, , cnn)
    Me![入厂ID] = rst![入厂ID]
    Me![客户ID] = rst![客户ID]
    Me![入厂日期] = rst![入厂日期]
    rst.Close
    
    
    '-----------改为查询
    strSQL = "SELECT * FROM [产品入厂查询_明细] WHERE [入厂ID]=" & SQLText(Me![入厂ID])
    Set rst = OpenADORecordset(strSQL, , cnn)
    Set rstTmp = CurrentDb.OpenRecordset("TMP_产品入厂明细表")
    Do Until rst.EOF
        rstTmp.AddNew
        rstTmp![入厂ID] = rst![入厂ID]
        rstTmp![合同ID] = rst![合同ID]
        rstTmp![产品ID] = rst![产品ID]
        '-------------后加的
        rstTmp![产品名称] = rst![产品名称]
        rstTmp![规格型号] = rst![规格型号]
        rstTmp![单位] = rst![单位]
        '------------------
        rstTmp![入厂数量] = rst![入厂数量]
        rstTmp![产品编号] = rst![产品编号]
        rstTmp![单价] = rst![单价]
        rstTmp.Update
        rst.MoveNext
    Loop
    rst.Close
    rstTmp.Close
    Me.sfrDetail.Requery
Form_frm产品入厂.sfrList.Requery
    
    
   
ExitHere:
    Set rst = Nothing
    Set cnn = Nothing
    Set rstTmp = Nothing
    Exit Sub
ErrorHandler:
    RDPErrorHandler Me.Name & ": Sub Form_Load()"
    Resume ExitHere
End Sub


kongkong 发表于:2018-04-17 14:48:17
Private Sub btnSave_Click()
    On Error GoTo ErrorHandler


    If Not CheckRequired(Me) Then Exit Sub
    If Not CheckTextLength(Me) Then Exit Sub
    If Not CheckRequired(Me.sfrDetail) Then Exit Sub


    Dim cnn: Set cnn = GetADOConnection()


    cnn.BeginTrans
    Dim blnTransBegin As Boolean: blnTransBegin = True


    Dim strSQL: strSQL = "SELECT * FROM [产品入厂表] WHERE [入厂ID]=" & SQLText(Me![入厂ID])
    Dim rst:    Set rst = ADO.OpenRecordset(strSQL, adLockOptimistic, cnn)
    If rst.EOF Then rst.AddNew
    UpdateRecord Me, rst
    '你的自定义代码
    'rst!Field1 = Me!Field1
    'rst!Field2 = Me!Field2
    rst.Update
    rst.Close


    cnn.Execute "DELETE FROM [产品入厂明细表] WHERE [入厂ID]=" & SQLText(Me![入厂ID])
    strSQL = "SELECT * FROM [产品入厂明细表] WHERE [入厂ID]=" & SQLText(Me![入厂ID])
    Set rst = ADO.OpenRecordset(strSQL, adLockOptimistic, cnn)
    Dim rstTmp: Set rstTmp = CurrentDb.OpenRecordset("TMP_产品入厂明细表")
    Do Until rstTmp.EOF
        rst.AddNew
        UpdateRecord rstTmp, rst
    '你的自定义代码
    'rst!Field1 = Me!Field1
    'rst!Field2 = Me!Field2
        rst![入厂ID] = Me![入厂ID]
        rst.Update
        rstTmp.MoveNext
    Loop
    rst.Close
    rstTmp.Close


    cnn.CommitTrans
    blnTransBegin = False


    RequeryDataObject gsfrList
    MsgBoxEx LoadString("Saved Successfully."), vbInformation


    If Me.DataEntry Then
        Me.InitData
    Else
        DoCmd.Close acForm, Me.Name, acSaveNo
    End If


ExitHere:
    Set rst = Nothing
    Set cnn = Nothing
    Set rstTmp = Nothing
    Exit Sub


ErrorHandler:
    If blnTransBegin Then
        cnn.RollbackTrans
        blnTransBegin = False
    End If
    RDPErrorHandler Me.Name & ": Sub btnSave_Click()"
    Resume ExitHere
End Sub


Private Sub btnCancel_Click()
    On Error Resume Next
    DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub ListXsd_Click()
 On Error GoTo ErrorHandler
   Dim strSQL As String
   Dim rst    As Object
   Dim rstTmp As Object
   
   If Me.ChlXsd.Form.Recordset.RecordCount > 0 Then
       CurrentDb.Execute "DELETE FROM [TMP_RC_产品入厂明细表]"
    End If
    
   strSQL = " SELECT * FROM 销售合同查询_明细 WHERE [合同ID]=" & SQLText(Me.ListXsd)
   Set rst = OpenADORecordset(strSQL, , CurrentProject.Connection)
   Set rstTmp = CurrentDb.OpenRecordset("TMP_RC_产品入厂明细表")
   
   Do Until rst.EOF
       rstTmp.AddNew
       rstTmp![合同ID] = rst![合同ID]
       rstTmp![产品ID] = rst![产品ID]
       rstTmp![产品名称] = rst![产品名称]
        rstTmp![规格型号] = rst![规格型号]
       rstTmp![单位] = rst![单位]
       rstTmp![单价] = rst![单价]
       
       rstTmp.Update
       rst.MoveNext
   Loop
   
   rst.Close
   rstTmp.Close
   
   Me.ChlXsd.Requery
 
ExitHere:
    Set rst = Nothing
    Set rstTmp = Nothing
    Exit Sub
    
   
ErrorHandler:
    MsgBoxEx Err.Description, vbCritical
    Resume ExitHere
    
End Sub






Private Sub 客户ID_AfterUpdate()
 Me.ListXsd.RowSource = " SELECT [合同ID] FROM  [销售合同表] WHERE [客户ID]=" & SQLText(Me![客户ID])
   Me.ListXsd.Requery
End Sub



kongkong 发表于:2018-04-17 14:49:11
3楼和4楼为主窗体代码

kongkong 发表于:2018-04-17 14:49:35
附件太大不知道怎么上传

HuangDuDu 发表于:2018-04-17 15:23:23
具体描述下子窗体2数据 无法保存吗   还是说保存了无法加载?

kongkong 发表于:2018-04-17 16:08:46
点击保存后,整个ACCESS无响应,再点就显示需要重新启动,不知道是不是代码有问题

SiliconXu 发表于:2018-04-17 22:57:59

有没有什么错误提示?

最好是把附件上传一下,不然这样子看你的代码很难理解。如果附件太大,你可以把不相关的窗体删了,减少附件尺寸。



总记录:9篇  页次:1/1 9 1 :