Public Function RecupParticipant(Projet As Long) As String
Dim res As DAO.Recordset
Dim SQL As String
'Selectionne les participant du projet
SQL = "SELECT NomParticipant FROM Tbl_Projet WHERE Projet=" & Projet
Set res = CurrentDb.OpenRecordset(SQL)
'Concatene les différents enregistrement
While Not res.EOF
    RecupParticipant = RecupParticipant & res.Fields(0).Value & " "
    res.MoveNext
Wend
'Enleve le dernier espace
RecupParticipant = Left(RecupParticipant, Len(RecupParticipant) - 1)
'libere la mémoire
Set res = Nothing
End Function

SELECT DISTINCT Tbl_projet.Projet, Recupparticipant(Projet) AS LesParticipants
FROM Tbl_projet;

Public Function RecupProjet(Nom As String) As String
Dim res As DAO.Recordset
Dim SQL As String
'Selectionne les  projet du partcipant
'chr(34) correspond a des guillemets pour encadrer le texte
SQL = "SELECT Projet FROM Tbl_Projet WHERE NomParticipant=" & _
          Chr(34) & Nom & Chr(34)
Set res = CurrentDb.OpenRecordset(SQL)
'Concatene les différents enregistrement
While Not res.EOF
    RecupProjet = RecupProjet & res.Fields(0).Value & ";"
    res.MoveNext
Wend
'Enleve le dernier ;
RecupProjet = Left(RecupProjet, Len(RecupProjet) - 1)
'libere la mémoire
Set res = Nothing
End Function

SELECT DISTINCT Tbl_projet.NomParticipant, Recupprojet(NomParticipant) AS LesProjets
FROM Tbl_projet;

Function fIntervalle(ByVal Valeur As Double, _
  Optional ByVal EspaceIntervalle As Double = 25) As String
    Dim l1 As Long
    Dim l2 As Long
 
    l1 = (Valeur \ EspaceIntervalle) * EspaceIntervalle
    If Valeur >= 0 Then
    l2 = l1 + EspaceIntervalle - 1
    fIntervalle = l1 & " à " & l2
    Else
    l2 = l1 - EspaceIntervalle + 1
    fIntervalle = l2 & " à " & l1
    End If
End Function

SELECT fIntervalle(note,5) AS Tranche, *
FROM tblNote
ORDER BY Val(fIntervalle(note,5));

TRANSFORM Count(R01.Eleve) AS CompteDeEleve
SELECT R01.Devoir
FROM R01
GROUP BY R01.Devoir
PIVOT R01.Tranche;

SELECT 
 (SELECT Count(Note) 
  FROM tbl_note T2
  WHERE T2.Note>T1.Note) AS Rang, 
T1.Note, *
FROM tbl_note AS T1
ORDER BY T1.Note DESC;

SELECT 
 (SELECT Count(Note)
  FROM (SELECT Distinct Note FROM tbl_note) T2
  WHERE T2.Note>T1.Note) AS Rang, 
T1.Note, *
FROM tbl_note AS T1
ORDER BY T1.Note DESC;

SELECT 
 (SELECT Count(Note)
  FROM  tbl_Note T2   
  WHERE T2.Note<T1.Note) AS Rang, T1.Note, *
FROM tbl_note AS T1
ORDER BY T1.Note;

SELECT 
 (SELECT Count(Note)
  FROM  (SELECT Distinct Note FROM tbl_note) T2 
  WHERE T2.Note<T1.Note) AS Rang, T1.Note, *
FROM tbl_note AS T1
ORDER BY T1.Note;

SELECT 
 (SELECT Count(Note)
  FROM   tbl_note T2   
  WHERE T2.Note<T1.Note) +1 AS Rang, T1.Note, *
FROM tbl_note AS T1
ORDER BY T1.Note;

SELECT 
 (SELECT Count(Note)
  FROM   tbl_note T2  
  WHERE T2.Note<T1.Note) +1 AS Rang, T1.Note, *
FROM tbl_note AS T1
ORDER BY T1.Note,Nom ;

Private Sub Dupliquer() 
Dim rstProtocole As DAO.Recordset, rstProtocole2 As DAO.Recordset 
Dim Db As DAO.Database, fld As DAO.Field 
Dim sql As String 
Dim id As Long 
Set Db = CurrentDb 
'Ouvre le recordset où sera prélevé le protocole 
Set rstProtocole = Db.OpenRecordset("SELECT NomProtocole FROM Protocole WHERE IdProtocole=1") 
'Verifie que le protocole 1 existe 
If rstProtocole.EOF Then Exit Sub 
'ouvre le recordset où sera ajouté le protocole 
Set rstProtocole2 = Db.OpenRecordset("protocole") 
'Duplique le protocole 
With rstProtocole2 
  .AddNew 
  'duplique les champs 
  For Each fld In rstProtocole.Fields 
    .Fields(fld.Name) = fld.Value 
  Next 
  id = .Fields("idprotocole") 
  .Update 
  'se positionne sur l'enregistrement ajouté 
End With 
 
'Duplique les lignes 
sql = "insert into LigneProtocole (IdProtocole,Libelleligne) SELECT " & _
  id & ", LibelleLigne FROM LigneProtocole WHERE idprotocole=1" 
Db.Execute sql 
End Sub

SELECT tbl_Jours.Numero & "/" & tbl_Mois.Numero & "/" & tbl_Annee.Numero AS D
FROM tbl_jours, tbl_mois, tbl_annee
WHERE IsDate(tbl_Jours.Numero & "/" & tbl_Mois.Numero & "/" & tbl_Annee.Numero)
ORDER BY tbl_annee.Numero, tbl_Mois.numero, tbl_Jours.numero;

SELECT NumEmploye, D
FROM TblAbsence, R01_Calendrier
WHERE D>=DebutAbsence AND D<=FinAbsence
ORDER BY NumEmploye,D

Option Compare Database
Option Explicit
Public Function Prepare(Mot As String) As String
'Cette fonction est inspirée de :
'http://sqlpro.developpez.com/cours/soundex/
'On enleve les espaces et convertit en majuscule
Dim I As Integer
Dim Caractere
Mot = Trim$(UCase$(Mot))
'On convertit les caractères accentués
For I = 1 To Len(Mot)
  Caractere = Mid(Mot, I, 1)
  Select Case Asc(Caractere)
    Case 192, 194, 196
      Prepare = Prepare & "A"
    Case 199
      Prepare = Prepare & "S"
    Case 200 To 203
      Prepare = Prepare & "E"
    Case 204, 206, 207
      Prepare = Prepare & "I"
    Case 212, 214
      Prepare = Prepare & "O"
    Case 217, 219, 220
      Prepare = Prepare & "U"
    Case Else
      If Caractere <> " " & Caractere <> "-" Then _
        Prepare = Prepare & Caractere
  End Select
Next I
End Function
Public Function Soundex(Mot As String) As String
Dim TLettre() As Variant
Dim I As Integer
Dim Lettre As String
Dim Tmp As String
'Tableau de correspondance
TLettre = Array("", "1", "2", "3", "", "1", "2", "", "", "2", _
            "2", "4", "5", "5", "", "1", "2", "6", "2", "3", _
            "", "1", "", "2", "", "2")
Mot = Prepare(Mot)
'cas particulier de chaine vide
If Len(Mot) = 0 Then
  Soundex = "0000"
Else
  'cas particulier de chaine à 1 caractère
  If Len(Mot) = 1 Then
    Soundex = Mot & "000"
  Else
  'Enleve le H (si présent) au début
  If Left(Mot, 1) = "H" Then Mot = Mid(Mot, 2)
  Soundex = Left(Mot, 1)
  For I = 2 To Len(Mot)
    Lettre = Mid(Mot, I, 1)
    'Transcode
    If Lettre >= "A" And Lettre <= "Z" Then
      Tmp = TLettre(Asc(Lettre) - Asc("A"))
      'Evite les doublons
      If Tmp <> Right(Soundex, 1) Then Soundex = Soundex & Tmp
    End If
  Next I
  End If
End If
'on recupère les 4 premiers
If Len(Soundex) >= 4 Then
  Soundex = Left(Soundex, 4)
Else
'sinon on complete
  For I = Len(Soundex) To 3
  Soundex = Soundex & "0"
  Next I
End If
End Function

TRANSFORM Nz(Sum(Commande.quantite),"0") AS SommeDequantite 
SELECT Commande.Ref, Nz(Sum(Commande.quantite),"0") AS Total 
FROM Commande 
GROUP BY Commande.Ref 
PIVOT Commande.mois;

TRANSFORM Nz(Sum(Commande.quantite),"0") AS SommeDequantite 
SELECT Commande.mois, Nz(Sum(Commande.quantite),"0") AS [Total de quantite] 
FROM Commande 
GROUP BY Commande.mois 
PIVOT Commande.Ref;

SELECT Commande.Ref, Mois, Commande.quantite AS Total,0 as Ordre 
FROM Commande 
UNION ( 
SELECT "TOTAL", Mois, sum(Quantite),1 as Ordre FROM Commande GROUP BY Mois,"TOTAL",1);

TRANSFORM Nz(Sum(Rtotal.Total),"0") AS SommeDeTotal 
SELECT Rtotal.Ref, Nz(Sum(Rtotal.Total),"0") AS [Total colonne] 
FROM Rtotal 
GROUP BY Rtotal.Ref, ordre 
ORDER BY Ordre 
PIVOT Rtotal.Mois;

ORDER BY Ordre DESC

SELECT joueur1 as J1,joueur2 AS J2,[setpourjoueur1] as PP,[setcontrejoueur1] as PC
FROM tblResultat
 
UNION SELECT joueur2 as J1,joueur1 AS J2,[setcontrejoueur1] as PP,[setpourjoueur1] as PC
FROM tblResultat
 
UNION SELECT DISTINCT joueur1 as J1,joueur1 as J2,"A" as PP,"A" AS PC FROM tblResultat;

TRANSFORM IIf(IsNull(First(PP)),"A jouer",
IIF(First(PP)="A","Non Jouable",First(PP) & "-" & First(PC))) AS Resultat
SELECT J1
FROM RPrepa
GROUP BY J1
PIVOT J2;

Sub anadecroise(Source As String, cible As String, nbfix As Integer)
 
    Dim base As DAO.Database
    Dim champ As DAO.Field
    Dim depart As DAO.Recordset
    Dim departdef As DAO.Fields
    Dim boucle As Integer
    Dim typechamp As Integer
    Dim incohérent As Boolean
    Dim sql As String
    Dim sqlb As String
 
    If Source = cible Then Exit Sub
    Set base = CurrentDb()
    'ici la procédure s'arrête si la table source n'existe pas
    Set depart = base.OpenRecordset(Source)
    Set departdef = base.TableDefs(Source).Fields
    'vérification du nombre de champ à transposer
    If nbfix + 2 > departdef.Count Then
        MsgBox "il doit y avoir au moins deux champs à transposer", vbCritical, "ERREUR"
        Exit Sub
    End If
    'vérification du type des champs de source
    typechamp = departdef(nbfix).Type
    incohérent = False
    For boucle = nbfix + 1 To departdef.Count - 1
        Set champ = departdef(boucle)
        If champ.Type <> typechamp Then incohérent = True
    Next boucle
    If incohérent Then
        MsgBox "tous les champs transposés doivent avoir le même type", vbCritical, "ERREUR"
        Exit Sub
    End If
    'création de la table cible et ajout de la première colonne à transposer
    sql = "SELECT "
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).name & ","
    Next boucle
    sql = sql & "'" & departdef(nbfix).name & "' as ipivot"
    sql = sql & ", " & departdef(nbfix).name & _
		" as dpivot into " & cible & " from " & Source & ";"
    Debug.Print sql
    DoCmd.RunSQL (sql)
    sql = "INSERT INTO " & cible & "("
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).name & ","
    Next boucle
    sql = sql & "ipivot,dpivot ) select "
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).name & ","
    Next boucle
    DoCmd.SetWarnings False
    'ajout des données suivantes
    For boucle = nbfix + 1 To departdef.Count - 1
        sqlb = sql & "'" & departdef(boucle).name & "' as ipivot," _
			 & departdef(boucle).name & " as dpivot from " & Source & ";"
        DoCmd.RunSQL (sqlb)
    Next boucle
    DoCmd.SetWarnings True
 
End Sub