[Déplacé VB6 - VBA] Access 2000 / Microsoft Visual basic. Problème d'export de

Question

Bonjour,
Tout d'abord je vous remercie de m'aider à essayer de résoudre ce problème. Et je suis désolé mais je ne suis pas sûre d'avoir posté ce message dans la bonne rubrique.... Je travaille actuellement sur une base de donnée sur Access 2000 et nous utilisons Microsoft Visual basic.... je ne sais pas si c'est le 6, le 2005... ou aucun des deux ! 
Dans mon association nous ne disposons pas d'informaticiens et nous "bidouillons" plus qu'autre chose... donc ce qui suit est probablement bourré de fautes et je m'en excuse d'avance --'.

Nous effectuons des visites d'évaluation que nous saisissons sur une base de données via un formulaire sous Access 2000.
Un bouton nous permet d'exporter les données de la base de données vers un document Word. Voici le code :


Option Compare Database
Option Explicit

'******************************************************************************
'* Procédure pour l'export de texte vers un document Word
'*
'******************************************************************************

Dim wApp As Word.Application 'toujours définir l'objet avec Dim avant de...
Dim ErrorSignet As Boolean

' Affiche une case non cochée
Private Sub CaseVide()
    wApp.Selection.InsertSymbol CharacterNumber:=168, Font:="Wingdings"
End Sub

' Affiche une case cochée
Private Sub CasePleine()
    wApp.Selection.InsertSymbol CharacterNumber:=254, Font:="Wingdings"
End Sub

' Sélectionne le signet donné
Private Function SelectSignet(Signet As String)
    ErrorSignet = True
'    On Error GoTo Fin
    wApp.ActiveDocument.Bookmarks.Item(Signet).Select
    
    ErrorSignet = False
    
Fin:
End Function

' Ecrit le texte indiqué sous Word, à l'emplacement du curseur
Private Function EcritTexte(Texte As Variant, Optional Different As String)
    If ErrorSignet Then Exit Function

    ' Traitement des valeurs textes
    If IsMissing(Different) Or Different <> Texte Then
        wApp.Selection.TypeText Nz(Texte)
    End If
End Function

' Ecrit le texte indiqué sous Word, à l'emplacement du curseur
Private Function EcritBooleen(Texte As Boolean, Optional SiVrai As String, Optional SiFaux As String)
    If ErrorSignet Then Exit Function

    ' Traitement des valeurs booléennes
    If IsMissing(SiVrai) Or IsMissing(SiFaux) Then
        wApp.Selection.TypeText IIf(Nz(Texte) = True, "Oui", "Non")
    Else
        wApp.Selection.TypeText IIf(Nz(Texte) = True, SiVrai, SiFaux)
    End If
End Function

' Remplace du texte
Private Function RemplaceTexte(Recherche As String, Remplace As String) As Boolean
    Dim rngStory As Word.Range
    Dim lngJunk As Long
    
    lngJunk = wApp.ActiveDocument.Sections(1).Headers(1).Range.StoryType
    
    'Iterate through all story types in the current document
    For Each rngStory In wApp.ActiveDocument.StoryRanges
        'Iterate through all linked stories
        Do
            With rngStory.Find
                .Text = Recherche
                .Replacement.Text = Remplace
                .MatchWholeWord = True
                .Forward = True
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
            'Get next linked story (if any)
            Set rngStory = rngStory.NextStoryRange
        Loop Until rngStory Is Nothing
    Next
End Function

Public Sub FindReplaceAlmostAnywhere()
End Sub

Public Sub ExportEval2(CODE_ETANG As String, DATE_VISITE As Date, nr_intervenant As Integer)

Dim rs01 As DAO.Recordset 'recordset de la table du de l'étang
Dim rs02 As DAO.Recordset
Dim rs03 As DAO.Recordset
Dim rs04 As DAO.Recordset
Dim rs05 As DAO.Recordset

Dim db As DAO.Database

Dim sql01 As String
Dim sql02 As String
Dim sql03 As String
'Dim sql04 As String
Dim sql05 As String

Dim Proprietaire As String

Dim strChemin As String 'Chemin vers la base de données
Dim objShape As InlineShape 'Images à insérer dans le doc


'Création des requêtes
sql01 = "SELECT etangs.[nom étang], T_intervenants_ZH.Dénomination AS Propriétaire, commcant.commune, [suivi assistance].[année programmation], [suivi assistance].[date visite diagnostic], T_intervenants_ZH.Adresse, T_intervenants_ZH.Code_postal & "" "" & T_intervenants_ZH.Commune AS Comcod, T_intervenants_ZH.[Date_adhésion] " & _
        "FROM (commcant INNER JOIN (etangs LEFT JOIN ([lien étang intervenant] LEFT JOIN T_intervenants_ZH ON [lien étang intervenant].[n_intervenant_CAT] = T_intervenants_ZH.[N_intervenant_CAT]) ON etangs.[n_ETANG] = [lien étang intervenant].[n_ETANG]) ON commcant.insee = etangs.commune) LEFT JOIN [suivi assistance] ON ([lien étang intervenant].n_ETANG = [suivi assistance].n_ETANG) AND ([lien étang intervenant].n_intervenant_CAT = [suivi assistance].n_intervenant_CAT)" & _
        "WHERE etangs.n_ETANG = '" & CODE_ETANG & "' " & _
        "AND [lien étang intervenant].n_intervenant_CAT = " & nr_intervenant & ""
sql02 = "SELECT * " & _
        "FROM T_Evaluation " & _
        "WHERE n_Etang '" & CODE_ETANG & "' And Date_Expert #" & DATE_VISITE & "# "
sql03 = "SELECT Pratiques " & _
        "FROM T_Evaluation_Pratiques " & _
        "WHERE n_Etang '" & CODE_ETANG & "' And Date_expertise #" & DATE_VISITE & "# " & _
        "ORDER BY id"
'sql04 = "SELECT Date_Expert " & _
'        "FROM T_Evaluation " & _
'        "WHERE n_Etang '" & CODE_ETANG & "'" And Date_Expert "#" & DATE_VISITE & "# " & _
'        "ORDER BY Date_Expert"
sql05 = "SELECT [n_intervenant_CAT], [date visite évaluation] AS D1, [date visite évaluation 2] AS D2, [date visite évaluation 3] AS D3, [date visite évaluation 4]AS D4, [date visite évaluation 5] AS D5, [date visite évaluation 6] AS D6, [date visite évaluation 7] AS D7, [date visite évaluation 8] AS D8 " & _
        "FROM [suivi assistance] " & _
        "WHERE n_Etang = '" & CODE_ETANG & "'" & _
        "AND n_intervenant_CAT = " & nr_intervenant & ""

Debug.Print sql01 & vbNewLine & sql02 & vbNewLine & sql03 & vbNewLine & sql05

Set db = CurrentDb
Set rs01 = db.OpenRecordset(sql01)
Set rs02 = db.OpenRecordset(sql02)
Set rs03 = db.OpenRecordset(sql03)
'Set rs04 = db.OpenRecordset(sql04)
Set rs05 = db.OpenRecordset(sql05)

Dim temp
Dim oDoc As Word.Document

If rs02.EOF Then
    MsgBox "Aucune évaluation effectuée, donc aucun rapport à générer !"
    Exit Sub
End If

strChemin = CurrentProject.Path 'la chaîne strChemin prend la valeur du répertoire dans lequel on a notre base de données
Set wApp = New Word.Application '... lui donner une référence
With wApp
    .Visible = True 'permet d'afficher à l'écran le transfert de texte
    'ouverture du document Word
    Set oDoc = .Documents.Add(strChemin & "\base_donnees\etangs_Modele_Eval_Nouveau-modele.doc")
End With


RemplaceTexte "{NOM_ETANG}", rs01.Fields("nom étang")
RemplaceTexte "{NOM_COMMUNE}", rs01.Fields("commune")
RemplaceTexte "{NOM_GESTIONNAIRE}", rs01.Fields("Propriétaire")
rs01.MoveFirst

SelectSignet "veAdresse"
EcritTexte rs01.Fields("Adresse") & " " & rs01.Fields("Comcod")

SelectSignet "Conseille"
EcritTexte rs02.Fields("Conseille")

SelectSignet "veDateVisite"
EcritTexte DATE_VISITE

SelectSignet "DateAdhesion"
EcritTexte rs01.Fields("date visite diagnostic")

SelectSignet "VisitesPrecedentes"
EcritTexte rs05.Fields("D1")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D2")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D3")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D4")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D5")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D6")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D7")

SelectSignet "veObservations"
EcritTexte rs02.Fields("Observations_Conservation")

SelectSignet "veEtat"
EcritTexte rs02.Fields("Etat_Conservation")

SelectSignet "veEvolutionInvasif"
EcritTexte rs02.Fields("Espece_Invasive")

SelectSignet "veEvolutionSite"
temp = rs02.Fields("Evolutions_site")
If Nz(temp) = "" Then
    EcritTexte "Pas de changement notable"
Else
    EcritTexte temp
End If

SelectSignet "veEvolutionVisite"
EcritTexte rs02.Fields("Evolution_Visite")

SelectSignet "veConseils"
EcritTexte rs02.Fields("Conseils_Observations_application")

SelectSignet "veSuivi"
EcritTexte rs02.Fields("Conseils_Suivis")

SelectSignet "veQuestions"
EcritTexte rs02.Fields("Questions_gestionnaire")

SelectSignet "vePratiques"
Do Until rs03.EOF
    EcritTexte "- " & rs03.Fields("Pratiques") & vbNewLine
    rs03.MoveNext
Loop

SelectSignet "veConseilGestion"
EcritTexte rs02.Fields("Conseils_gestion")

SelectSignet "veAspectReglementaire"
EcritTexte rs02.Fields("Aspects_reglementaires")

SelectSignet "veSuite"
EcritTexte rs02.Fields("Suite_donner")

'oDoc.Close wdDoNotSaveChanges

Set oDoc = Nothing
Set db = Nothing
Set rs01 = Nothing


End Sub



Ce code marchait jusqu'à présent pour les 2nd visites. Il marche toujours pour générer les anciennes visites (saisies il y a 1 an environ). Mais pour les visites saisies depuis quelques mois impossible de le faire marcher. La commande
If rs02.EOF Then
    MsgBox "Aucune évaluation effectuée, donc aucun rapport à générer !"
    Exit Sub
End If
ce mettant en route.

Je ne sais pas si ça a un lien mais certains de nos postes (dont le mien) sont passés de Windows XP à windows 7....
Je vous remercie d'avoir pris le temps de prendre connaissance de mon problème.

Merci encore, en attendant une éventuelle réponse ....
Bonne journée

cs_Jack · Answer

Salut

Le VB de la suite Office s'appelle du VBA, pas du VB6 (bien qu'ils se ressemblent)

Première chose à faire : Présenter ton code proprement. Perso, je n'ai pas le courage de lire ça.
- Quand tu colles du code, utilise la coloration syntaxique = 3ème icone à droite. Elle colorisera et conservera l'indentation des lignes (les espaces en tête de ligne)
- Les lignes trop longues sont difficiles à lire : Utilise dans ton code le symbole _ en fin de ligne pour poursuivre à la ligne du dessous, exemples :
Pour une instruction standard :
Debug.Print sql01 & vbNewLine & _
            sql02 & vbNewLine & _
            sql03 & vbNewLine & _
            sql05Pour une chaine de caractères :
sql01 = "SELECT etangs.[nom étang], " & _
        "       T_intervenants_ZH.Dénomination AS Propriétaire, " & _
        "       commcant.commune, " & _
        "       [suivi assistance].[année programmation], " & _
        "       [suivi assistance].[date visite diagnostic], " & _
        "       T_intervenants_ZH.Adresse, " & _
        "       T_intervenants_ZH.Code_postal & "" "" & " & _
        "       T_intervenants_ZH.Commune AS Comcod, " & _
        "       T_intervenants_ZH.[Date_adhésion] "
        "  FROM (commcant INNER JOIN (etangs LEFT JOIN " & _etc
On n'a le droit qu'à 21 césures avec _
Il te faudra donc surement répéter le nom de la variable de temps à autre :
sql01 = "Select ..."
sql01 = sql01 & " Where ..."
On y verra plus clair.
Dans un second temps, regarde le format des dates.
En général, les dates sont stockées au format US dans les DB, donc inversion des mois et jours.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

capu2 · Answer

Bonjour,

Merci pour tes conseils.... je suis désolée que ce soit si brouillon... pour la coloration syntaxique il y a un code couleur à respecter?? Est ce qu'il faut que je laisse les informations précédé par un ' et qui sont en vert dans VBA?
Et d'ailleurs j'ai posté ma question au bon endroit vu que c'est du VBA et non du VB6??

Je vais reposter le code de façon plus lisible (enfin je vais essayer --' ) et regarder cette histoire de date. Mais normalement elles sont saisie au même format, le formulaire et les tables qui y sont attaché n'ont pas subies de modification.

Merci beaucoup de ton aide en tout cas...

Bonne journée

capu2 · Answer

Bon suite à tes conseils j'ai essayé de faire un code plus "propre".... S'il y a des trucs qui vont pas, ou si c'est toujours pas lisible, surtout dis le... je suis pas vraiment douée dans ce domaine!!

C'est peut être pas la peine de mettre tout le code mais je suis incapable de localiser l'erreur...


Option Compare Database
Option Explicit

Dim wApp As Word.Application 
Dim ErrorSignet As Boolean

Private Sub CaseVide()
wApp.Selection.InsertSymbol CharacterNumber:=168, Font:="Wingdings"
End Sub

Private Sub CasePleine()
wApp.Selection.InsertSymbol CharacterNumber:=254, Font:="Wingdings"
End Sub

Private Function SelectSignet(Signet As String)
ErrorSignet = True
' On Error GoTo Fin
wApp.ActiveDocument.Bookmarks.Item(Signet).Select

ErrorSignet = False

Fin:
End Function

Private Function EcritTexte(Texte As Variant, Optional Different As String)
If ErrorSignet Then Exit Function

If IsMissing(Different) Or Different <> Texte Then
wApp.Selection.TypeText Nz(Texte)
End If
End Function

Private Function EcritBooleen(Texte As Boolean, Optional SiVrai As String, Optional SiFaux As String)
If ErrorSignet Then Exit Function

If IsMissing(SiVrai) Or IsMissing(SiFaux) Then
wApp.Selection.TypeText IIf(Nz(Texte) = True, "Oui", "Non")
Else
wApp.Selection.TypeText IIf(Nz(Texte) = True, SiVrai, SiFaux)
End If
End Function

Private Function RemplaceTexte(Recherche As String, Remplace As String) As Boolean
Dim rngStory As Word.Range
Dim lngJunk As Long

lngJunk = wApp.ActiveDocument.Sections(1).Headers(1).Range.StoryType

For Each rngStory In wApp.ActiveDocument.StoryRanges
Do
With rngStory.Find
.Text = Recherche
.Replacement.Text = Remplace
.MatchWholeWord = True
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Function

Public Sub FindReplaceAlmostAnywhere()
End Sub

Public Sub ExportEval2(CODE_ETANG As String, DATE_VISITE As Date, nr_intervenant As Integer)

Dim rs01 As DAO.Recordset 
Dim rs02 As DAO.Recordset
Dim rs03 As DAO.Recordset
Dim rs04 As DAO.Recordset
Dim rs05 As DAO.Recordset

Dim db As DAO.Database

Dim sql01 As String
Dim sql02 As String
Dim sql03 As String
'Dim sql04 As String
Dim sql05 As String

Dim Proprietaire As String

Dim strChemin As String 'Chemin vers la base de données
Dim objShape As InlineShape 'Images à insérer dans le doc

sql01 = "SELECT etangs.[nom étang], " &  _
        "       T_intervenants_ZH.Dénomination AS Propriétaire, " &  _
        "       commcant.commune, " &  _
        "       [suivi assistance].[année programmation], " &  _
        "       [suivi assistance].[date visite diagnostic], " &  _
        "       T_intervenants_ZH.Adresse, " &  _
        "       T_intervenants_ZH.Code_postal & "" "" & T_intervenants_ZH.Commune AS Comcod, " &  _
        "       T_intervenants_ZH.[Date_adhésion] " & _
        "FROM (commcant INNER JOIN (etangs LEFT JOIN ([lien étang intervenant] " &  _
        "     LEFT JOIN T_intervenants_ZH ON [lien étang intervenant].[n_intervenant_CAT] = T_intervenants_ZH.[N_intervenant_CAT]) " &  _
        "     ON etangs.[n_ETANG] = [lien étang intervenant].[n_ETANG]) ON commcant.insee = etangs.commune) " &  _
        "     LEFT JOIN [suivi assistance] ON ([lien étang intervenant].n_ETANG = [suivi assistance].n_ETANG) " &  _
        "     AND ([lien étang intervenant].n_intervenant_CAT = [suivi assistance].n_intervenant_CAT)" & _
        "WHERE etangs.n_ETANG = '" & CODE_ETANG & "' " & _
        "      AND [lien étang intervenant].n_intervenant_CAT = " & nr_intervenant & ""
sql02 = "SELECT * " & _
        "FROM T_Evaluation " & _
        "WHERE n_Etang '" & CODE_ETANG & "' And Date_Expert #" & DATE_VISITE & "# "
sql03 = "SELECT Pratiques " & _
        "FROM T_Evaluation_Pratiques " & _
        "WHERE n_Etang '" & CODE_ETANG & "' And Date_expertise #" & DATE_VISITE & "# " & _
        "ORDER BY id"
'sql04 = "SELECT Date_Expert " & _
'        "FROM T_Evaluation " & _
'        "WHERE n_Etang '" & CODE_ETANG & "'" And Date_Expert "#" & DATE_VISITE & "# " & _
'        "ORDER BY Date_Expert"
sql05 = "SELECT [n_intervenant_CAT], " & _
        "       [date visite évaluation] AS D1, " & _
        "       [date visite évaluation 2] AS D2, " & _
        "       [date visite évaluation 3] AS D3, " & _
        "       [date visite évaluation 4]AS D4, " & _
        "       [date visite évaluation 5] AS D5, " & _
        "       [date visite évaluation 6] AS D6, " & _
        "       [date visite évaluation 7] AS D7, " & _
        "       [date visite évaluation 8] AS D8 " & _
        "FROM [suivi assistance] " & _
        "WHERE n_Etang = '" & CODE_ETANG & "'" & _
        "      AND n_intervenant_CAT = " & nr_intervenant & ""

Debug.Print sql01 & vbNewLine & _
            sql02 & vbNewLine & _
            sql03 & vbNewLine & _
            sql05

Set db = CurrentDb
Set rs01 = db.OpenRecordset(sql01)
Set rs02 = db.OpenRecordset(sql02)
Set rs03 = db.OpenRecordset(sql03)
'Set rs04 = db.OpenRecordset(sql04)
Set rs05 = db.OpenRecordset(sql05)

Dim temp
Dim oDoc As Word.Document

If rs02.EOF Then
MsgBox "Aucune évaluation effectuée, donc aucun rapport à générer !"
Exit Sub
End If

strChemin = CurrentProject.Path 
Set wApp = New Word.Application 
With wApp
.Visible = True 

Set oDoc = .Documents.Add(strChemin & "\base_donnees\etangs_Modele_Eval_Nouveau-modele.doc")
End With


RemplaceTexte "{NOM_ETANG}", rs01.Fields("nom étang")
RemplaceTexte "{NOM_COMMUNE}", rs01.Fields("commune")
RemplaceTexte "{NOM_GESTIONNAIRE}", rs01.Fields("Propriétaire")
rs01.MoveFirst

SelectSignet "veAdresse"
EcritTexte rs01.Fields("Adresse") & " " & rs01.Fields("Comcod")

SelectSignet "Conseille"
EcritTexte rs02.Fields("Conseille")

SelectSignet "veDateVisite"
EcritTexte DATE_VISITE

SelectSignet "DateAdhesion"
EcritTexte rs01.Fields("date visite diagnostic")

SelectSignet "VisitesPrecedentes"
EcritTexte rs05.Fields("D1")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D2")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D3")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D4")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D5")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D6")
wApp.Selection.MoveRight wdCell
EcritTexte rs05.Fields("D7")

SelectSignet "veObservations"
EcritTexte rs02.Fields("Observations_Conservation")

SelectSignet "veEtat"
EcritTexte rs02.Fields("Etat_Conservation")

SelectSignet "veEvolutionInvasif"
EcritTexte rs02.Fields("Espece_Invasive")

SelectSignet "veEvolutionSite"
temp = rs02.Fields("Evolutions_site")
If Nz(temp) = "" Then
EcritTexte "Pas de changement notable"
Else
EcritTexte temp
End If

SelectSignet "veEvolutionVisite"
EcritTexte rs02.Fields("Evolution_Visite")

SelectSignet "veConseils"
EcritTexte rs02.Fields("Conseils_Observations_application")

SelectSignet "veSuivi"
EcritTexte rs02.Fields("Conseils_Suivis")

SelectSignet "veQuestions"
EcritTexte rs02.Fields("Questions_gestionnaire")

SelectSignet "vePratiques"
Do Until rs03.EOF
EcritTexte "- " & rs03.Fields("Pratiques") & vbNewLine
rs03.MoveNext
Loop

SelectSignet "veConseilGestion"
EcritTexte rs02.Fields("Conseils_gestion")

SelectSignet "veAspectReglementaire"
EcritTexte rs02.Fields("Aspects_reglementaires")

SelectSignet "veSuite"
EcritTexte rs02.Fields("Suite_donner")

'oDoc.Close wdDoNotSaveChanges

Set oDoc = Nothing
Set db = Nothing
Set rs01 = Nothing


End Sub


Encore merci pour ton aide
Capucine

cs_loulou69 · Answer

bonjour

Je te conseillerai de faire des select simples
select * from table
en faire autant que nécessaire

faire ensuite des select "liste des champs nommés" from table

puis les compléter avec les clauses where

select simples pour vérifier si les tables sont vides
en testant "if rs.EOF then Msgbox" 

et faire des msgbox encadrant chacune des valeurs des clauses Where  ">" & valeur & "<" 

et enfin assembler "requete" et "clause where"

capu2 · Answer

Bonjour,

Ok merci, je vais essayer de faire des select plus simple... seulement pourquoi ca marche pour les visites saisie il y a 1 an et pas pour celle qu'on saisies maintenant?? (j'ai testé les anciennes marche toujours).

Et les tables sont pleine.... mais ça marche pas quand même.

Merci de ton aide

cs_titicar · Answer

Vu qu'il y a un test pour sql02, pourquoi ne pas essayer de commencer très simple :
sql02 = "SELECT * FROM T_Evaluation"

Puis vérifier le nombre de rs02.

Et si ça marche, alors compléter la requête au fur et à mesure:
sql02 = "SELECT * FROM T_Evaluation " & _
        "WHERE n_Etang = '" & CODE_ETANG & "'"
Et ainsi de suite.

Par contre si dès le début, ça ne fonctionne pas, on saura qu'il faut cherché l'erreur dans la table T_Evaluation


titicar

capu2 · Answer

Bonjour,
Merci beaucoup de votre aide malheureusement ça ne marche toujours pas...
Il doit y avoir un souci avec DATE_VISITE
"WHERE n_Etang '" & CODE_ETANG & "' And Date_Expert #" & DATE_VISITE & "# "

En faisant autant de requête qu'il y a de table ça ne marche pas...
Pour ce qui est de tester sql02... aussi surprenant que ça puisse paraitre (et contre toute attente), il trouve tous les enregistrements....

Une de mes collègues a saisi une visite de 2nd année qu'elle a réussi à exporter... en fait il veut bien exporter certaines visite, mais pour d'autres il bloque totalement... on a trouvé aucun point commun entre ces visites (pour l'instant).

Comme alternative à ce problème serait t-il possible d'avoir une fenêtre qui s'affiche au moment de l'export, dans laquelle on saisi la date de la visite que l'on souhaite exporter?

Encore merci de votre patience et de votre aide.

Capucine

cs_loulou69 · Answer

bonjour

Le pb n'est t'il pas que le moteur Access veut une date à l'anglaise : MM/DD/YYYY month/day/year?

Dim s as String
s = InputBox ("Saisir une date :", "mm/jj/aaaa")

and 
faire un formulaire avec un combobox
y  ajouter toutes les occurences de 

select distinct(DATE_EXPERT) from T_EVALUATION

renvoyer le résultat de la selection à affecter à la variable DATE_VISITE dans la requete précédente :

soit:
WHERE n_Etang '" & CODE_ETANG & "' And Date_Expert #" & DATE_VISITE & "# "

capu2 · Answer

Oulala.....  Merci beaucoup mais je suis vraiment désolée, je ne suis pas sure du tout d'avoir tout compris là! J'ai des grosses lacunes en VBA...
Une combobox c'est une liste déroulante c'est ca?? donc (bien que ne sachant pas ce que sont les occurences (mais je vais chercher)) j'en déduis que c'est une liste avec toutes les dates saisies? On ne peux pas faire une recherche par date directement?

Pour les dates je ne pense pas que ce soit ça puisque certains export marchent pour la 2nd année. Si le problème venait de là aucune visite de 2nd année ne pourrait s'exporter (à moins que je me trompe et que la logique m'échappe).

cs_loulou69 · Answer

pour les combo tu as compris mais en fefet commence par un InputBox


sinon voilà un peu d'aide pour un combobox
ajouter une occurence à un combobox ça doit être AddItem
remplir un combo "cb"

Call RemplirCombo(cb,""select distinct(DATE_EXPERT) from T_EVALUATION")


Sub RemplirCombo(cb as ComboBox, SQL as String)
dim rs as ADODB.Recordset
cb.Clear 'effacer toutes les occurence
rs.open SQL , cnn
if not rs.EOF  Then
While not rs.EOF
  cb.addItem rs.Fields(i)
  i=i+1
  rs.MoveNext
Wend
End If
End Sub

capu2 · Answer

Ok merci pour l'explication. 
Je vais surement paraitre stupide, mais InputBox c'est pas une fenêtre avec que du texte?

capu2 · Answer

Autant pour moi c'est pour la saisie des valeur... mais je veux retrouver un enregistrement à partir d'une date, j'arrive pas a trouver comment on fait ça me remplis le champ à chaque fois. Je dois mal m'y prendre, je vais encore creuser.
Merci beaucoup,
Bonne fin de journée
Capu

capu2 · Answer

Bonjour,
Bon j'ai essayé de redéfinir le format de la DATE_VISITE mais ce n'est pas concluant... Soit je m' prend mal soit ce n'est pas ça.
J'utilise 
Format(Date, dd/mm/yyyy)
Mais qu'en j'active le bouton il me dit qu'il y a une erreur d'exécution... Que dois je faire... sauvez moi s'il vous plait!!

[Déplacé VB6 -> VBA] Access 2000 / Microsoft Visual basic. Problème d'export de

13 réponses

Votre réponse

Discussions similaires