---

Public Sub TraiterSample()
 
  Dim ClefSampleRef As String 'Je suppose que c'est du texte
  Dim cptSample As Long
 
  Dim load_assays As dao.Database: Set load_assays = CurrentDb
  load_assays.QueryDefs("Empty_Result_temp").Execute
 
  Dim Populate_export As dao.Recordset: Set Populate_export = load_assays.OpenRecordset("Populate_export") 'rSample
 
  Dim Result_temp As dao.Recordset: Set Result_temp = load_assays.OpenRecordset("Result_temp", dbOpenDynaset) 'rResultat
 
  Do While Not Populate_export.EOF()
 
      If ClefSampleRef <> Populate_export![Sample_no] Then
        Result_temp.AddNew 'Ajoute un nouvel enregsitrement
        Result_temp![Sample_no] = Populate_export![Sample_no]
        Result_temp.Update
 
        ClefSampleRef = Populate_export![Sample_no] 'Note la nouvelle clef de référence
        cptSample = 0 'Reinitialise le compteur de valeur
      End If
 
    Result_temp.FindFirst ("[Sample_no]=""" & Populate_export![Sample_no] & """")
 
      If Not Result_temp.NoMatch Then
          Result_temp.Edit
          cptSample = cptSample + 1
          Result_temp.Fields("Au1_1ppm" & cptSample) = Populate_export![Au1_1ppm]  'Recopie la valeur dans le résultat dans la colonne voulue
        Else
          Error 5 'Cas impossible, soit il existait soit on l'a créé
      End If
 
      Populate_export.MoveNext 'Lit le sample suivant
  Loop
 
  Result_temp.Close: Set Result_temp = Nothing 'Ferme la source de données, libère la mémoire
  Populate_export.Close: Set Populate_export = Nothing 'Ferme la source de données, libère la mémoire
 
  Set load_assays = Nothing 'Libère la mémoire utilisé par l'objet db
End Sub

---

---

Result_temp.Fields("Au1_1ppm" & cptSample) = Populate_export![Au1_1ppm]

---

---

Private Sub Document_New()
Dim Response, varTHR As Integer, varConfirm, varAge As Integer
10 Response = InputBox("Enter Your Age in Years")

If Not IsNumeric(Response) Or Response <= 0 Then

varConfirm = MsgBox("Entered data is not valid ...." & vbCrLf & _
"Do You Wish To Quit ?", vbYesNo, "Confirm ")

If varConfirm = vbYes Then
Exit Sub
Else
GoTo 10
End If

Else
varAge = Response
End If


20 Response = InputBox("Enter Your Resting Heart Rate (RHR)", "Your RHR Please !!")

If Not IsNumeric(Response) Or Response <= 0 Then

If varConfirm = vbYes Then
Exit Sub
Else
GoTo 20
End If

Else

varTHR = 0.7 * (220 - varAge) + 0.3 * Response

End If

MsgBox "Your Calculated THR based on your Input " & vbCrLf & vbCrLf & _
"Age : " & varAge & vbCrLf & "RHR : " & Response & "----------" & vbCrLf & _
varTHR

GoTo 10
End Sub

---

---

Private Sub ID_CREATE()
Data1.Refresh
Data1.RecordSource = "select * from TableName order by ID"
Data1.Refresh

If Data1.Recordset.RecordCount > 0 Then
    Data1.Recordset.MoveLast
    ' FC/11-12/ = 9 Character
    X = Val(Mid(Data1.Recordset.Fields("ID"), 10)) + 1
Else
    X = 1
End If
If X <= 9 Then
    l2.Caption = "FC/11-12/0000" & X
ElseIf X <= 99 Then
    l2.Caption = "FC/11-12/000" & X
ElseIf X <= 999 Then
    l2.Caption = "FC/11-12/00" & X
ElseIf X <= 9999 Then
    l2.Caption = "FC/11-12/0" & X
Else
    l2.Caption = "FC/11-12/" & X
End If
End Sub

---

Attached Files

UF_AD654.zip (273.1 KB)

---

Private Sub cmdRandomRoll_Click()
    Dim intTemp As Integer
    Dim rstRecords As ADODB.Recordset
    Dim strSelect As String
   
    Set rstRecords = New ADODB.Recordset
   
    intTemp = Generate_Random_Number(100, 1)
    strSelect = "SELECT ID FROM tblExperimentNature WHERE " & intTemp & " >= RollLow AND " & intTemp & " <= RollHigh"
    rstRecords.Open strSelect, adoHUConnection, adOpenKeyset, adLockOptimistic
    rstRecords.MoveFirst
   
    For intTemp = 0 To grdNature.Rows - 1
        If grdNature.TextMatrix(intTemp, 0) = rstRecords!ID Then
            grdNature.Row = intTemp
            grdNature.RowSel = grdNature.Row
            grdNature.SetFocus
            Call grdNature_Click
            Exit For
        End If
    Next
   
    rstRecords.Close

    intTemp = Generate_Random_Number(100, 1)
    strSelect = "SELECT ID FROM tblExperimentType WHERE " & intTemp & ">= RollLow AND " & intTemp & " <= RollHigh"
    rstRecords.Open strSelect, adoHUConnection, adOpenKeyset, adLockOptimistic
    rstRecords.MoveFirst
   
    For intTemp = 0 To grdType.Rows - 1
        If grdType.TextMatrix(intTemp, 0) = rstRecords!ID Then
            grdType.Row = intTemp
            Call grdType_Click
            Exit For
        End If
    Next
   
    rstRecords.Close
    Set rstRecords = Nothing
End Sub

---