Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

VBA et Query

P

Philippe Boudier

Guest
Bonjour,

J'ai un soucis que je n'arrive pas à résoudre et je remercie d'avance la personne qui résoudra mon problème.

J'ai fait un progamme VBA (voir ci dessous) qui me permet de faire une requête sous Query à partir d'un fichier DBF. Dans certains champs il y a des dates que je souhaiterais paramétrer dans des cellules Excel ( date début et fin). Je n'arrive pas à trouver la syntaxe qui me permettrait de changer les dates en dur dans le programme par une liaison avec les cellules Excel ou des constantes qui feraient référence au contenu de ces cellules.

D'avance merci.
Cordialement




With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DRIVER={Hyper File};ANA=G:\DONNEES\TRAMICO\ANALYSE\TRAMICO.WDD;;REP=G:\DONNEES\TRAMICO\FIC\;ANA=G:\DONNEES\TRAMICO\ANALYSE\TRAM" _
), Array("ICO.WDD")), Destination:=Range("A1"))
.CommandText = Array( _
"SELECT BOAP.BODPCODE, BOAP.BODPDATE, BOAP.CC_PCODE, BOAP.ST_PCODE, BOAP.BOAPQTEL, BOAP.AR_PPRIX, BOAP.AR_PUTAR" & Chr(13) & "" & Chr(10) & "FROM G:\DONNEES\TRAMICO\ANALYSE\TRAMICO.WDD~BOAP BOAP" & Chr(13) & "" & Chr(10) & "WHERE (BOAP.BODPDATE>={d '2003-12-02'} And BOAP.BODPDATE<={d '2003-12-04'})" _
, "AND (BOAP.BODPCODE<>'Z' And BOAP.BODPCODE<>'Z')" _
, "" & Chr(13) & "" & Chr(10) & "ORDER BY BOAP.BODPDATE, BOAP.CC_PCODE, BOAP.ST_PCODE")
.Name = "tri des Produits"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
 
P

Pascal76

Guest
bonjour Philippe

Regarde ce code que j'avais fait il y a quelques temps déjà. Je pense que cela peut t'aider. Je récupérais 1 date de début et une date de fin que je mettais en forme pour les utiliser ensuite dans ma requête.

____________________________________________________________

QDateDeb = InputBox("Quelle est la date de début de la période ?", "Période de remplacement.")
If IsDate(QDateDeb) Then
DateDeb = QDateDeb
monjour = Format(Day(DateDeb), "00")
monmois = Format(Month(DateDeb), "00")
monannee = Format(Year(DateDeb), "0000")
datedeb1 = monannee & "-" & monmois & "-" & monjour

ElseIf QDateDeb = "" Then
Exit Sub
Else: MsgBox "Vous devez rentrer une date sous le format jj/mm/aa."
GoTo ErDateDeb
End If

ErDateFin:
QDateFin = InputBox("Quelle est la date de fin de la période ?", "Période de remplacement.")
If IsDate(QDateFin) Then
DateFin = QDateFin
monjour = Format(Day(DateFin), "00")
monmois = Format(Month(DateFin), "00")
monannee = Format(Year(DateFin), "00")
datefin1 = monannee & "-" & monmois & "-" & monjour

ElseIf QDateFin = "" Then
Exit Sub
Else: MsgBox "Vous devez rentrer une date sous le format jj/mm/aa."
GoTo ErDateFin
End If

nbreligne = Range("A2").CurrentRegion.Rows.Count
Range(Cells(3, 1), Cells(nbreligne, 9)).Select

Selection.ClearContents

Range("A2").Select

With Selection.QueryTable
.Connection = _
"ODBC;DRIVER={Hyper File};ANA=J:\GESPERS\HSF\GESPERS.WDD;REP=J:\GESPERS\;ANA=J:\GESPERS\HSF\GESPERS.WDD;"
.CommandText = Array( _
"SELECT REMPLACE.NOMREMPLAC, REMPLACE.PREREMPLAC, REMPLACE.NOMTITULAI, REMPLACE.PRETITULAI, REMPLACE.TYPEABSENC, REMPLACE.DEBREMPL, REMPLACE.FINREMPL" & Chr(13) & "" & Chr(10) & "FROM J:\GESPERS\HSF\GESPERS.WDD~REMPLACE REMPLACE" & Chr(13) & "" _
, "" & Chr(10) & "WHERE (REMPLACE.FINREMPL>{d " & Chr(39) & datedeb1 & Chr(39) & "}) AND (REMPLACE.DEBREMPL<{d " & Chr(39) & datefin1 & Chr(39) & "})")
.Refresh BackgroundQuery:=False
End With
____________________________________________________________

Tiens moi au courant et bon courage car je me rappelle que j'en avais du temps à tout mettre en fonction.

Pascal
 
P

Philippe Boudier

Guest
Merci ça marche.
C'est la première fois que j'utilise ce forum et je trouve cela super, car je me sentais isolé pour résoudre ce genre de problème

Cordialement
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…