1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
|
Private Sub bt_creat_Click()
Dim maBD As DAO.Database
Dim strSql As String
Dim QDF1 As DAO.QueryDef, nouvelleRQ As QueryDef
Dim rst As DAO.Recordset
Dim sMessage As String, sTitle As String, sDefault As String
Dim nouveauNom As String, intReturn
Dim sNomTable As String, sNomRQ As String
On Error GoTo Err_Click
sNomTable = "t_listQryOrg"
Set maBD = CurrentDb
'1 Saisir le nom en clair de la nouvelle requete
'###############################################
sMessage = "Entrez une chaîne de caractères (< 40 car)"
sTitle = "Saisie du nom de la nouvelle requête " 'Titre en clair de la Rq
sDefault = "nouveau_nom" 'Valeur par défaut.
nouveauNom = InputBox(sMessage, sTitle, sDefault)
intReturn = DCount("[noRQ]", sNomTable, "[nomDansListe] = '" & nouveauNom & "'")
Debug.Print Nz(intReturn)
If Nz(intReturn) > 1 Then
'cas de doublons
MsgBox "le libellé de la nouvelle requête existe déjà en doublons dans la base ! ", vbCritical, "Problème de doublons"
GoTo Exit_Click
ElseIf Nz(intReturn) = 1 Then
' Une requête avec le même nom existe déjà dans la base
MsgBox " Une requête avec ce même nom existe déjà dans la base ! ", vbCritical, "Problème de doublons"
GoTo Exit_Click
Else
' cas Nz(intReturn) = 0
End If
'2 en déduire le nom de la nouvelle requête
'###############################################
sNomRQ = "r_list_" & nouveauNom
'3 Mettre à jour la table liste des requetes
'###############################################
strSql = "INSERT into " & sNomTable & " (nomDansListe,nomRQ) " _
& " values (""" & nouveauNom & """,""" & sNomRQ & """) ; "
Debug.Print "INSERT: " & strSql
DoCmd.RunSQL strSql, 0
Set QDF1 = maBD.QueryDefs("r_model1") 'modèle de requête
Set nouvelleRQ = maBD.CreateQueryDef(sNomRQ, QDF1.SQL)
DoCmd.OpenQuery sNomRQ, A_DESIGN
DoCmd.ShowToolbar "Requête édition", A_TOOLBAR_YES
Me.Requery
Me!noRQliste.Requery
Exit_Click:
Err_Click:
End Sub |
Partager