根据三个已知条件，从数据库中查找对应的最后50条信息显示在下方

ym21ht

魂断蓝桥 发表于 2020-3-30 09:39
On Error GoTo 100
    cnn.Open "Provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\test. ...

Option Explicit
Dim m As Boolean
Sub 开始()
Dim bt$, CNN, RS, SQL$, TJ$, i%, NewTime
bt = " [WRN#],班次,录入员,生产线,品种,取样时间,吸碘值,吸油值,[325#水洗],[200#水洗],[100#水洗],[35#水洗],[10#粒子],最大颗粒强度,平均颗粒强度,最小颗粒强度,水分,倾注密度,罐号,温度"
Sheet1.Unprotect Password:="123"
If m = True Then m = False: Exit Sub
For i = 2 To 4 Step 2
    TJ = TJ & Cells(3, i - 1) & "='" & Cells(3, i) & "' and "
Next
TJ = Left(TJ, Len(TJ) - 4)
NewTime = Now + TimeValue("00:01:00")
Set CNN = CreateObject("ADODB.Connection")
Set RS = CreateObject("adodb.Recordset")
CNN.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\数据库.accdb" & ";Jet OLEDB:Database Password=123578951;"
SQL = "select top " & [f3] & bt & " from 生产命令单 where " & TJ & " order by id desc"
SQL = "select * from (" & SQL & ") order by [WRN#]"
[a17:t23] = ""
Range("A17").CopyFromRecordset CNN.Execute(SQL)
[a17:a22].NumberFormatLocal = "yyyy/m/d hh:mm:ss"
[f17:f22].NumberFormatLocal = "hh:mm:ss"
SQL = "select top " & [j3] & bt & " from 生产命令单 where " & TJ & " order by id desc"
SQL = "select * from (" & SQL & ") order by [WRN#]"
[a27:t77] = ""
Range("A27").CopyFromRecordset CNN.Execute(SQL)
[f27:f77].NumberFormatLocal = "hh:mm:ss"
Set RS = Nothing
Set CNN = Nothing
Application.OnTime NewTime, "开始"
Sheet1.Protect Password:="123"
End Sub

Sub 结束()
m = True
End Sub

ym21ht

魂断蓝桥 发表于 2020-3-30 09:39
On Error GoTo 100
    cnn.Open "Provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\test. ...

代码加到哪里呢？

ym21ht

魂断蓝桥 发表于 2020-3-30 09:28
先判断一下是否被打开。

On Error GoTo 100

试了好几次 都不行 麻烦大神给修改下

魂断蓝桥

ym21ht 发表于 2020-3-31 09:05
试了好几次 都不行 麻烦大神给修改下

上次你得截图是网络文件，你上传的是本地文件，
是不是这个意思，如果acc已经被别人打开则提示文件正在使用？



Private Sub CommandButton1_Click()
    '引用Microsoft AD0 Ext 2.8 for DDL and Security
    On Error GoTo 100
    ActiveSheet.Unprotect Password:=123
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim SQL As String
    Dim i As Integer
    Dim strMsg As String
    If MsgBox("保存后将无法修改，是否已确认无误？", vbYesNo, "警告") = vbYes Then
        If Range("D6") = "" Then
            MsgBox "必须输入生产线", 1 + 16, "出错提示"
            Exit Sub
        ElseIf Range("E6") = "" Then
            MsgBox "必须输入品种", 1 + 16, "出错提示"
            Exit Sub
        ElseIf Range("F6") = "" Then
            MsgBox "必须输入取样时间", 1 + 16, "出错提示"
            Exit Sub
        End If
        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\数据库.accdb" & ";Jet OLEDB:Database Password=123578951;"
        SQL = "SELECT * FROM 生产命令单 WHERE [WRN#]=#" & Range("a6") & "#"
        rst.Open SQL, cnn, adOpenKeyset, adLockOptimistic
        If rst.RecordCount = 0 Then
            rst.AddNew
            For i = 1 To rst.Fields.Count - 1
                rst.Fields(i) = Cells(6, i)
                [A6].NumberFormatLocal = "yyyy/m/d hh:mm:ss"
            Next
            rst.Update
            strMsg = "数据保存成功。"
            Range("D6:T6").ClearContents
        Else
            strMsg = "WRN# [ " & Sheet1.Range("a6") & " ] 的信息已存在，不能重复添加！"
        End If
        MsgBox strMsg, vbInformation, "提示"
        rst.Close
        cnn.Close
        ActiveSheet.Protect Password:=123
        Set rst = Nothing
        Set cnn = Nothing
    End If
    Exit Sub
100:
    MsgBox Err.Description & vbLf & "请稍后重试"
End Sub

ym21ht

魂断蓝桥 发表于 2020-3-31 09:29
上次你得截图是网络文件，你上传的是本地文件，
是不是这个意思，如果acc已经被别人打开则提示文件正在 ...

大神，弄混了，我给你上传的那个文件 是解决 这个问题上传的文件，您给我说了代码以后，这个问题完美解决了。
现在是另外一个问题， 显示端 设定的是1分钟一刷新，从数据库调取数据，因为我有多个显示，有可能在录入端正在录入的时候，ACC正在打开，而显示端正好这个时候调取数据库，造成出现文件正在使用中的报错。我想实现显示端在出现这个错误的时候，不提示错误弹出框，也不调数据了，直接退出VBA运行，等下下一分钟刷新的时候再运行，附件上传了

魂断蓝桥

ym21ht 发表于 2020-3-31 13:56
大神，弄混了，我给你上传的那个文件 是解决这个问题上传的文件，您给我说了代码以后，这个问题完美解决 ...

那这样试一试

Option Explicit
Dim m As Boolean
Sub 开始()
    On Error GoTo 100
    Dim bt$, CNN, RS, SQL$, TJ$, i%, NewTime
    bt = " [WRN#],班次,录入员,生产线,品种,取样时间,吸碘值,吸油值,[325#水洗],[200#水洗],[100#水洗],[35#水洗],[10#粒子],最大颗粒强度,平均颗粒强度,最小颗粒强度,水分,倾注密度,罐号,温度"
    Sheet1.Unprotect Password:="123"
    If m = True Then m = False: Exit Sub
    For i = 2 To 4 Step 2
        TJ = TJ & Cells(3, i - 1) & "='" & Cells(3, i) & "' and "
    Next
    TJ = Left(TJ, Len(TJ) - 4)
    NewTime = Now + TimeValue("00:00:05")
    Set CNN = CreateObject("ADODB.Connection")
    Set RS = CreateObject("adodb.Recordset")
    CNN.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\数据库.accdb" & ";Jet OLEDB:Database Password=123578951;"
    SQL = "select top " & [f3] & bt & " from 生产命令单 where " & TJ & " order by id desc"
    SQL = "select * from (" & SQL & ") order by [WRN#]"
    [a17:t23] = ""
    Range("A17").CopyFromRecordset CNN.Execute(SQL)
    [a17:a22].NumberFormatLocal = "yyyy/m/d hh:mm:ss"
    [f17:f22].NumberFormatLocal = "hh:mm:ss"
    SQL = "select top " & [j3] & bt & " from 生产命令单 where " & TJ & " order by id desc"
    SQL = "select * from (" & SQL & ") order by [WRN#]"
    [a27:t77] = ""
    Range("A27").CopyFromRecordset CNN.Execute(SQL)
    [f27:f77].NumberFormatLocal = "hh:mm:ss"
    Set RS = Nothing
    Set CNN = Nothing
    Application.OnTime NewTime, "开始"
    Sheet1.Protect Password:="123"
    Exit Sub
100:
    Resume Next
End Sub

Sub 结束()
    m = True
End Sub

ym21ht

魂断蓝桥 发表于 2020-3-31 14:22
那这样试一试

Option Explicit

好的 我试下