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
sql01 = "Select ..." sql01 = sql01 & " Where ..."
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionsql02 = "SELECT * FROM T_Evaluation"
sql02 = "SELECT * FROM T_Evaluation " & _ "WHERE n_Etang = '" & CODE_ETANG & "'"
"WHERE n_Etang '" & CODE_ETANG & "' And Date_Expert #" & DATE_VISITE & "# "