1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Vb+sql pour requete modulable

Vb+sql pour requete modulable

Soyez le premier à donner votre avis sur cette source.

Snippet vu 9 981 fois - Téléchargée 36 fois

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

Ajouter un commentaire

Commentaires

Signaler
Messages postés
94
Date d'inscription
dimanche 9 mai 2004
Statut
Membre
Dernière intervention
6 août 2006
C'est une fonction pour exporter dans excel que j'ai fait une fois... remarque le shell... et les liens (linktopic, linkmode, linkpoke).... le code n'est pas optimisé du tout
espérant que cela t'aide ... du moins t'inspire !!

Private Sub mnuExportExcel_Click()
Dim Prenom, Nom, Telephone, Cellulaire, Padget, Adresse, Email, Commentaires As String
Dim Colonne, Rangee As String
Dim Row As Integer
Dim ReturnVal
Row = 2
adoCarnet.Recordset.MoveFirst


If (txtPrenom.LinkMode vbnone And txtNom.LinkMode vbnone) Then

'execution d'excel
ReturnVal = Shell("D:\Program Files\Microsoft Office\Office11\Excel.exe", 3)

If ReturnVal Then

txtPrenom.LinkTopic = "Excel|Book1" ' Définit la rubrique de liaison.
txtPrenom.LinkItem = "R1C1" ' Définit l'élément de liaison.
txtPrenom.LinkMode = vbLinkManual ' Définit le mode de liaison.

txtNom.LinkTopic = "Excel|Book1" ' Définit la rubrique de liaison.
txtNom.LinkItem = "R1C2" ' Définit l'élément de liaison.
txtNom.LinkMode = vbLinkManual ' Définit le mode de liaison.

txtTelephone.LinkTopic = "Excel|Book1"
txtTelephone.LinkItem = "R1C3"
txtTelephone.LinkMode = vbLinkManual

txtPadget.LinkTopic = "Excel|Book1"
txtPadget.LinkItem = "R1C4"
txtPadget.LinkMode = vbLinkManual

txtCellulaire.LinkTopic = "Excel|Book1"
txtCellulaire.LinkItem = "R1C5"
txtCellulaire.LinkMode = vbLinkManual

txtCommentaire.LinkTopic = "Excel|Book1"
txtCommentaire.LinkItem = "R1C6"
txtCommentaire.LinkMode = vbLinkManual
End If

End If

Do While Not adoCarnet.Recordset.EOF
Row = Row + 1 ' Définit le numéro de ligne.

txtPrenom.LinkItem = "R" & Row & "C1" ' Défint l'élément de liaison.
txtPrenom.LinkPoke ' Force le transfert de la valeur dans la cellule.

txtNom.LinkItem = "R" & Row & "C2" ' Définit l'élément de liaison.
txtNom.LinkPoke ' Force le transfert de la valeur dans la cellule.

txtTelephone.LinkItem = "R" & Row & "C3" ' Définit l'élément de liaison.
txtTelephone.LinkPoke ' Force le transfert de la valeur dans la cellule.

txtPadget.LinkItem = "R" & Row & "C4" ' Définit l'élément de liaison.
txtPadget.LinkPoke ' Force le transfert de la valeur dans la cellule.

txtCellulaire.LinkItem = "R" & Row & "C5" ' Définit l'élément de liaison.
txtCellulaire.LinkPoke ' Force le transfert de la valeur dans la cellule.

txtCommentaire.LinkItem = "R" & Row & "C6" ' Définit l'élément de liaison.
txtCommentaire.LinkPoke ' Force le transfert de la valeur dans la cellule.


adoCarnet.Recordset.MoveNext

Loop

End Sub
Signaler
Messages postés
2
Date d'inscription
lundi 15 décembre 2003
Statut
Membre
Dernière intervention
8 août 2004
Pour imprimer je n'ai pas d'idée par contre pour exporter vers excel tu peux reprendre ta chaine sql
et ecrire un truc du genre :
Dim cnSrc As New ADODB.Connection
Dim monsql As String
Dim moncritere as String

Screen.MousePointer = vbHourglass
DoEvents
cnSrc.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=(ma base de données access.mdb);Persist Security Info=False"

'select * from matable into [Excel 8.0; Database=test.xls]

cnSrc.Execute Monsqll & "INTO [Excel 8.0;" & _
"Database="Nom du fichier excel "]" & Mon critere, num_copied
cnSrc.Close

Screen.MousePointer = vbDefault
MsgBox "Copiés " & num_copied & " lignes."
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.