Recherche de chaine de caracteres dans une requete d'une base de données access.

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 984 fois - Téléchargée 29 fois

Commenter

Contenu du snippet

Ce bout de code, permet de faire une recherche dans toutes les requetes Access d'une chaine de caracteres a rechercher. Celui ci affichera toutes les requetes qui trouvent dans la fenetre correspondante. Un simple double clique sur un résultat, ouvrira la requete en mode création.
L'autre fonction de ce code est l'affichage SQL d'une requete d'une base de données Access.

L'utilité ?
Lorsqu'on a a refaire pleins de requetes, ou à les rendre dynamiques. Une simple recherche, un copier coller dans le code suffise. Ca évite bcp de manipulations pour ouvrir une requete et récupérer son code SQL.

Elements du formulaire ?
- Boite modifiable * 2 (noms : SQL_Search, SQL_Query)
- Liste (nom : lst_SQL)
- Zone de texte (nom : SQL_Def)
- Boutons * 2 (noms : commande2, SQL_Exec_Def)
Désolé pour les noms des éléments, c'est un peu à la va vite ! (Beaucoup meme, mais vous saurez les renommer :) )

Source / Exemple :

' on déclare nos variables avec la portée du formulaire entier
Dim bd As Database
Dim strSearch  As String
Dim strResultat As String

Private Sub Commande2_Click()
    
    ' initialisation des variables
    Dim query As QueryDef ' Définition de requete
    
    ' affection de valeur aux variables
    strResultat = ""
    
    ' On controle le champs de la valeur a chercher
    If SQL_Search.Value <> vbNullString Then
        ' On recupere la valeur a rechercher
        strSearch = SQL_Search.Value
        
        ' on parcourt toutes les requetes de la base de données
        For Each query In bd.QueryDefs
            ' si on trouve la chaine de caractere dans le code SQL de
            ' la requete en cours alors on récupere son nom
            If InStr(1, query.SQL, strSearch) Then
                ' On recupere le nom de la requete, et la séparer par un ';'
                ' avec les autres résultats
                strResultat = strResultat & query.Name & ";"
            End If
        ' on boucle sur la prochaine requete
        Next
        ' si on a pas de résultat
        If strResultat = "" Then
            ' on en averti l'utilisateur
            strResultat = "Non trouvé"
        End If
    Else
        ' la chaine a recherché est vide
        strResultat = "Pas de valeurs indiqué"
    End If
    
    ' le contenu de la liste est une liste de valeurs.
    ' ce qui signifie, que Access mettra dans la liste, chaque éléments séparé par des ';'
    lst_SQL.RowSourceType = "Value List"
    ' On affecte le résulat a la liste
    lst_SQL.RowSource = strResultat
End Sub

Private Sub Form_Load()
    ' on instancie la base de données courante
    Set bd = CurrentDb
End Sub

Private Sub lst_SQL_DblClick(Cancel As Integer)
    ' on a double cliqué sur un résultat, on ouvre la requete en mode création
    DoCmd.OpenQuery lst_SQL.Value, acViewDesign
End Sub

Private Sub SQL_Exec_Def_Click()
    ' Déclaration des variables
    Dim query As QueryDef ' Définition de requete
    
    ' affection de valeur aux variables
    strResultat = ""
    
    ' On vérifie la présence d'informations
    If SQL_Search.Value <> vbNullString Then
        'On recupere la chaine a rechercher
        strSearch = SQL_Query.Value
        
        ' on parcourt toutes les requetes de la base
        For Each query In bd.QueryDefs
            ' si on trouve une correspondance entre la chaine a recherché
            ' et la requete en cours alors on a trouvé un resultat
            If InStr(1, query.Name, strSearch) Then
                ' on recupere le code SQL de la requete trouvé
                strResultat = query.SQL
                ' on sort du FOR
                Exit For
            Else
                ' On a trouvé aucun résultat, on le signale
                strResultat = "Non trouvé"
            End If
        ' Hop, on boucle sur la prochaine requete
        Next
    Else
        ' le nom de la requete a rechercher est vide
        strResultat = "Pas de valeurs indiqué"
    End If
    ' On affiche le résultat trouvé
    SQL_Def.Value = strResultat
End Sub

Conclusion :

J'ai essayé de la commenter au maximum. Ce bout de code n'a la prétention de rien, juste peut etre de jouer sur plusieurs terrains (liste, boucle, collections, controle de champs...) pour aider les newbies comme moi. ^^

Soyez indulgent c'est ma 1ere source :$

Merci à vous, et bonne critique :)

A voir également

Ajouter un commentaire Commentaires

Signaler

rabie505

Messages postés: 2
Date d'inscription: samedi 2 février 2008
Statut: Membre
Dernière intervention: 2 février 2008

2 févr. 2008 à 23:38

rocedure TForm1.Button9Click(Sender: TObject);
begin
Table1.Open;
Table1.First;
if Table1.FindKey([Edit1.Text]) then
begin
Edit1.Text:=CurrToStr(Table1Numro_E.Value);
Edit2.Text:=Table1Nom_E.Value;
Edit3.Text:=Table1Prnom_E.Value;
Edit4.Text:=DateToStr(Table1Daten_E.Value);
Edit5.Text:=Table1Spcialiter.Value;
end
else
if not Table1.FindKey([Edit1.Text]) then
ShowMessage('Cet Etudiant non trouvé...');
end;

end.
j'ai aider comment recherche par "nom" dans ce programme et merci

Signaler

rabie505

Messages postés: 2
Date d'inscription: samedi 2 février 2008
Statut: Membre
Dernière intervention: 2 février 2008

2 févr. 2008 à 23:35

object ScrollBox: TScrollBox
Left = 0
Top = 121
Width = 864
Height = 537
HorzScrollBar.Margin = 6
VertScrollBar.Margin = 6
Align = alClient
AutoSize = True
BiDiMode = bdRightToLeft
BorderStyle = bsNone
Color = clSkyBlue
ParentBiDiMode = False
ParentColor = False
TabOrder = 1
DesignSize = (
864
537)
object Label1: TLabel
Left = 720
Top = 296
Width = 129
Height = 33
Alignment = taRightJustify
AutoSize = False
Caption = ':'#199#225#227#230#214#220#220#220#220#220#220#230#218
Font.Charset = ARABIC_CHARSET
Font.Color = clBlue
Font.Height = -19
Font.Name = 'Mudir MT'
Font.Style = [fsBold, fsUnderline]
ParentFont = False
end
object Label2: TLabel
Left = 736
Top = 144
Width = 113
Height = 33
Alignment = taRightJustify
AutoSize = False
Caption = ':'#237#220#220#220#220#230#227' '#199#225#197#211#202#222#200#199#225
Font.Charset = ARABIC_CHARSET
Font.Color = clBlue
Font.Height = -19
Font.Name = 'Mudir MT'
Font.Style = [fsBold, fsUnderline]
ParentFont = False
end
object Label3: TLabel
Left = 680
Top = 410
Width = 165
Height = 39
Alignment = taRightJustify
AutoSize = False
Caption = ':'#199#225#197#204#209#199#193#199#202' '#199#225#227#202#206#208#201
Font.Charset = ARABIC_CHARSET
Font.Color = clBlue
Font.Height = -19
Font.Name = 'Mudir MT'
Font.Style = [fsBold, fsUnderline]
ParentFont = False
end
object Label5: TLabel
Left = 728
Top = 98
Width = 121
Height = 31
Alignment = taRightJustify
AutoSize = False
Caption = ':'#199#225#197#211#220#220#220#227' '#230#199#225#225#222#220#220#220#200
Font.Charset = ARABIC_CHARSET
Font.Color = clBlue
Font.Height = -19
Font.Name = 'Mudir MT'
Font.Style = [fsBold, fsUnderline]
ParentFont = False
end
object Label6: TLabel
Left = 728
Top = 199
Width = 121
Height = 34
Alignment = taRightJustify
AutoSize = False
Caption = ':'#199#225#213#221#201' '#195#230' '#199#225#230#217#237#221#201
Font.Charset = ARABIC_CHARSET
Font.Color = clBlue
Font.Height = -19
Font.Name = 'Mudir MT'
Font.Style = [fsBold, fsUnderline]
ParentFont = False
end
object Label7: TLabel
Left = 744
Top = 248
Width = 105
Height = 33
Alignment = taRightJustify
AutoSize = False
Caption = ':'#227#223#220#220#220#220#199#228' '#199#225#197#222#199#227#201
Font.Charset = ARABIC_CHARSET
Font.Color = clBlue
Font.Height = -19
Font.Name = 'Mudir MT'
Font.Style = [fsBold, fsUnderline]
ParentFont = False
end
object DBEdit1: TDBEdit
Left = 40
Top = 96
Width = 681
Height = 41
Anchors = [akTop, akRight, akBottom]
AutoSelect = False
AutoSize = False
DataField = 'Nom'
DataSource = DataSource1
Font.Charset = ARABIC_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Mudir MT'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
end
object DBMemo1: TDBMemo
Left = 40
Top = 440
Width = 809
Height = 89
DataField = 'Decition'
DataSource = DataSource1
Font.Charset = ARABIC_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Mudir MT'
Font.Style = [fsBold]
ParentFont = False
ScrollBars = ssVertical
TabOrder = 1
end
object DBMemo2: TDBMemo
Left = 40
Top = 328
Width = 809
Height = 89
DataField = 'Objet'
DataSource = DataSource1
Font.Charset = ARABIC_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Mudir MT'
Font.Style = [fsBold]
ParentFont = False
ScrollBars = ssVertical
TabOrder = 2
end
object DBEdit2: TDBEdit
Left = 584
Top = 152
Width = 137
Height = 33
Anchors = [akTop, akRight, akBottom]
AutoSize = False
DataField = 'Date'
DataSource = DataSource1
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 3
end
object DBEdit3: TDBEdit
Left = 40
Top = 200
Width = 684
Height = 41
Anchors = [akTop, akRight, akBottom]
AutoSize = False
DataField = 'Fonction'
DataSource = DataSource1
Font.Charset = ARABIC_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Mudir MT'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 4
end
object DBEdit4: TDBEdit
Left = 40
Top = 256
Width = 684
Height = 41
Anchors = [akTop, akRight, akBottom]
AutoSize = False
DataField = 'Adresse'
DataSource = DataSource1
Font.Charset = ARABIC_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Mudir MT'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
end
object Button1: TButton
Left = 752
Top = 0
Width = 81
Height = 25
Caption = 'Ajouter'
Font.Charset = OEM_CHARSET
Font.Color = clRed
Font.Height = -21
Font.Name = 'Roman'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 6
OnClick = Button1Click
end
object Button2: TButton
Left = 632
Top = 0
Width = 113
Height = 25
Caption = 'Suprimer'
Font.Charset = OEM_CHARSET
Font.Color = clRed
Font.Height = -21
Font.Name = 'Roman'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 7
OnClick = Button2Click
end
object Button3: TButton
Left = 544
Top = 0
Width = 75
Height = 25
Caption = 'Effacer'
Font.Charset = OEM_CHARSET
Font.Color = clRed
Font.Height = -21
Font.Name = 'Roman'
Font.Style = []
ParentFont = False
TabOrder = 8
OnClick = Button3Click
end
object Button4: TButton
Left = 400
Top = 0
Width = 123
Height = 25
Caption = 'Recherche'
Font.Charset = OEM_CHARSET
Font.Color = clRed
Font.Height = -21
Font.Name = 'Roman'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 9
OnClick = Button4Click
end
object Button5: TButton
Left = 296
Top = 0
Width = 75
Height = 25
Caption = 'Quiter'
Font.Charset = OEM_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'Roman'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 10
OnClick = Button5Click
end
end

Signaler

zilfi63

Messages postés: 4
Date d'inscription: jeudi 19 avril 2007
Statut: Membre
Dernière intervention: 21 janvier 2008

24 mai 2007 à 10:48

Bonjour à tous,

Merci Apsy pour ce code, et j'aurait une question pour tout le monde

J'ai créé un formulaire à recherche multi-critere
L'utilisateur a le choix de choisir dabord dans une première liste déroulante soit la table CLIENT, soit la table MACHINE et le résultat devrait s'afficher dans une zone de liste.
Ma 2ème liste déroulante contient, selon le choix de la table sur lequel la recherche à lieu, les champs de celle-ci

Une zone texte permet de mettre le critère à la recherche !
Mais lorsque je veux lancer la recherche, ma zone de liste est vide.
Rien ne s'affiche

Voici le code de la commande rechercher...Je suis débutante en VBA et je voudrais vraiment savoir ce qui ne va pas dans ce code

Merci d'avance pour vos réponses

Private Sub CmdRech_Click()
Dim strTable As String, strField As String, strCriteria As String, strSql As String
Dim Criter As Variant

strTable = Me.cbo_Table ' recupère le nom de la table
strField = Me.cbo_champ ' recupère le nom du champ

' compose le critere de recherche
SintTypChamp = lf_GetTypeField(strTable, strField) ' pour trouver le type du champs ...
intOpeChamp = Me.T_Recherche

Dim intTypChamp As Integer
Dim intOpeChamp As Integer

Select Case intTypChamp

Case dbBoolean ' bool
If intOpeChamp = 1 Then ' oui
strCriteria = strTable & "." & strField & "=-1"
ElseIf intOpeChamp = 2 Then ' non
strCriteria = strTable & "." & strField & "=0"
Else
strCriteria = strTable & "." & strField & "=Null"
End If

Case dbByte To dbBinary, dbLongBinary, dbBigInt To dbVarBinary, dbNumeric To dbTimeStamp
' traite les numeriques
strCriteria = Me.txt_critere

If intTypChamp dbDate And IsDate(Me.txt_critere) Then strCriteria "#" _
& Me.txt_critere & "#" ' type champ = date
' rajoute les dièses

If Not IsNull(Me.txt_critere) Then
Select Case intOpeChamp ' numerique, date
Case 1 ' strCriteria strTable & "." & strField & "=" & strCriteria

Case 2 ' >strCriteria strTable & "." & strField & ">=" & strCriteria

Case 3 ' <strCriteria strTable & "." & strField & "<=" & strCriteria

Case 4 '<>
strCriteria = strTable & "." & strField & "<>" & strCriteria
End Select
End If

Case dbText, dbMemo, dbChar ' texte
Select Case intOpeChamp

Case Else
MsgBox "Cas non prévu."
Exit Sub
End Select
End Select

If Me.OptRechCourante And Not Len(Me.lst_Resultat.RowSource) = 0 Then
If Not Me.lst_Resultat.RowSource Like "*FROM " & strTable & "*" Then
MsgBox "La recherche précédente ne porte pas sur la même table que la recherche actuelle.", _
vbExclamation + vbOKOnly, "Erreur"
Exit Sub
End If
strSql = Left(Me.lst_Resultat.RowSource, Len(Me.lst_Resultat.RowSource) - 3)
strSql = strSql & " AND " & strTable & "." & strCriteria & "));"
Else
' construit la rq sql
strSql = "SELECT DISTINCTROW " & strTable & ".*"
strSql = strSql + " FROM " & strTable
strSql = strSql + " WHERE ((" & strTable & "." & strCriteria & "));"
End If
' construit la requête sql
Me.lst_Resultat.RowSource = strSql ' affecte sql a lst_result
Me.lst_Resultat.Requery ' rafraîchi la liste

End Sub

Signaler

cs_Apsy

Messages postés: 3
Date d'inscription: mardi 25 février 2003
Statut: Membre
Dernière intervention: 19 juillet 2004

19 juil. 2004 à 13:09

Effectivement, jmlucienvb, tu as raison ! Car l'erreur provient de moi. J'ai mis qu'il fallait 2 liste déroulantes ou lieu d'une liste déroulante et d'une zone de texte !
Je vais corriger ca de suite :)
Mais la source est bonne sinon.

Amicalement :)

Signaler

jmlucienvb

Messages postés: 129
Date d'inscription: mercredi 24 septembre 2003
Statut: Membre
Dernière intervention: 12 février 2009

19 juil. 2004 à 08:11

' On affiche le résultat trouvé
SQL_Def.Value = strResultat

Non : plutôt :

SQL_Def.RowSource = strResultat
Enfin je pense suivant mes essais...

Afficher les 8 commentaires

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.

Source / Exemple :

Conclusion :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Vous n'êtes pas encore membre ?

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