Vb+sql pour requete modulable

Commenter

Contenu du snippet

cette source sert essentiellement à avoir une requete modulable
rajout simple de critères
ceux ci étant entrer dans un formulaire access
en option un bouton de suppression

Source / Exemple : 


Option Compare Database
Option Explicit
Public Monjeuenreg As String

Public Sub Recherche_Click()
    
    'construction d'une requête SQL
    '  Crée une clause WHERE en utilisant le critère recherche entré
    '  par l'utilisateur et définit la propriété Source (RecordSource)
    '  du sous-formulaire affichage
    Dim Monsql As String, MonCritère As String
    Dim NbrArg As Integer
    Dim Tmp As Variant

    '  Initialise le compteur d'argument.
    NbrArg = 0

    '  Initialise l'instruction SELECT.
    Monsql = "SELECT * FROM R_Recherche WHERE"
    MonCritère = ""

    '  Utilise les valeurs entrées dans les zones de texte de l'en-tête de fomrulaire
    '  pour créer les critères de la clause WHERE. entre " " le nom du champ
    AjouteràWhere [Groupe_tx], "[e_Groupe]", MonCritère, NbrArg
    AjouteràWhere [Espece_tx], "[o_Espece]", MonCritère, NbrArg
   

    '  Si aucun critère n'est spécifié, renvoie tous les enregistrements.
    If MonCritère = "" Then
    MonCritère = "True"
    End If

    '  Crée l'instruction SELECT.
    Monjeuenreg = Monsql & MonCritère
    
    '  Défini la propriété RecordSource du sous-formulaire recherche.
    Me![Sousform_affichage].Form.RecordSource = Monjeuenreg
    
    '  Si aucun enregistrement ne correspond aux critères, affiche un message.
    '  Active le bouton Effacer.
    If Me![Sousform_affichage].Form.RecordsetClone.RecordCount = 0 Then
        MsgBox "Aucun enregistrement ne correspond aux critères introduits.", 48, "Aucun enregistrements trouvés"
        Me!SupprimerRecherche.SetFocus
    Else
        '  Active le contrôle dans la section détail.
        Tmp = ActiveContrôles("Detail", True)
        '  Place le point d'insertion dans le sous-formulaire.
        Me![Sousform_affichage].SetFocus
    End If
End Sub

Private Sub AjouteràWhere(ValeurChamp As Variant, NomChamp As String, MonCritère As String, NbrArg As Integer)
    Dim opérateur As String, ponctue As String, cote As String
    '  Crée le critère pour la clause WHERE.
opérateur = " like "
ponctue = "*"
cote = "'"
    If ValeurChamp <> "" Then
        '  Ajoute "et" si aucun critère existe.
        If NbrArg > 0 Then
            MonCritère = MonCritère & " And "
        End If
    If ValeurChamp <> "" And NomChamp = "[e_Groupe 44]" Then
        opérateur = " like "
        ponctue = ""
        cote = "'"
    End If

        '  Ajoute le critère aux critères existants
        MonCritère = (MonCritère & NomChamp & opérateur & cote & ValeurChamp & ponctue & cote)
        
        '  Augmente le compteur d'argument.
        NbrArg = NbrArg + 1
    End If

End Sub
Private Sub SupprimerRecherche_Click()

' remettre les champs à null
    Dim Monsql As String
 
    Monsql = "SELECT * FROM R_Recherche WHERE False"
    
    Me![Groupe_tx] = Null
    Me![Espece_tx] = Null
 
    '  Réinitialise la propriété RecordSource du sous-formualire pour retirer les enregistrements.
    Me![Sousform_affichage].Form.RecordSource = Monsql

    '  Place le point d'insertion dans la première zone de texte Recherche.
    Me![Espece_tx].SetFocus
    
End Sub
Option Compare Database
Option Explicit

Function ActiveContrôles(QuelleSection As String, Etat As Integer) As Integer
Dim MonFormulaire As Form
Dim MonContrôle As Control
Dim i As Integer, SectionChoisie As Integer

    On Error Resume Next
    Set MonFormulaire = Screen.ActiveForm
    If Err Then
        ActiveContrôles = False
        On Error GoTo 0
        Exit Function
    End If
    Select Case UCase$(QuelleSection)
        Case "FORM HEADER"
            SectionChoisie = 1
        Case "PAGE HEADER"
            SectionChoisie = 3
        Case "DETAIL"
            SectionChoisie = 0
        Case "PAGE FOOTER"
            SectionChoisie = 4
        Case "FORM FOOTER"
            SectionChoisie = 2
        Case Else
            MsgBox "Argument invalide", , "ActiveContrôles"
            ActiveContrôles = False
            Exit Function
    End Select

    For i = 0 To MonFormulaire.Count - 1
        Set MonContrôle = MonFormulaire(i)
        If MonContrôle.Section = SectionChoisie Then
        On Error Resume Next
        MonContrôle.Enabled = Etat
        On Error GoTo 0
        End If
    Next i

    ActiveContrôles = True

End Function

Conclusion :


prévue un bouton pour imprimer et exporter vers excel
mais pour l'instant encore quelques problèmes
si quelqu'un à une idée, elle serait bien sur la bienvenue

merci à tous

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.