SCRIPT EXEMPLE UTILISANT UNE BASE ACCESS

/// ‘Champs à créer ‘dans les renseignements généraux : ‘———————————- ‘TXHORCHANTIER numérique ‘COEFREVIENTCHANTIER numérique ‘dans les chantiers : ‘———————————- ‘TXHORCHANTIER numérique ‘COEFREVIENTCHANTIER numérique ‘DATEMAJ Date ‘ZSUP1 numérique Heures prévues ‘ZSUP2 numérique Montant déboursé hors MO prévu ‘ZSUP3 numérique Prix de revient prévu calculé ‘ZSUP4 numérique HT devis ‘ZSUP5 numérique Bénéfice prévu ‘ZSUP6 numérique ‘ZSUP7 numérique ‘ZSUP8 numérique ‘ZSUP9 numérique ‘ZSUP10 numérique ‘ZSUP11 numérique Heures réalisées ‘ZSUP12 numérique Montant cdes fournisseurs réceptionnées ‘ZSUP13 numérique Prix de revient réel calculé ‘ZSUP14 numérique HT factures – avoirs ‘ZSUP15 numérique Bénéfice réel ‘ZSUP16 numérique ‘ZSUP17 numérique ‘ZSUP18 numérique ‘ZSUP19 numérique ‘ZSUP20 numérique ‘************************************************************************** ‘DECLARATION DES VARIABLES ‘————————————————————————– ‘Option Explicit ‘Constantes bases de données ‘CursorLocation Const adUseServer = 2 ‘Uses a server-side cursor provided by the local library Const adUseClient = 3 ‘Uses a client-side cursor provided by the local library ‘LockType Const adLockBatchOptimistic = 4 ‘Multiple users can modify the data and the changes are cached until BatchUpdate is called Const adLockOptimistic = 3 ‘Multiple users can modify the data which is not locked until Update is called Const adLockPessimistic = 2 ‘The provider locks each record before and after you edit, and prevents other users from modifying the data Const adLockReadOnly = 1 ‘Read-only data Const adLockUnspecified = -1 ‘Lock type unknown ‘CursorType Const adOpenStatic = 3 ‘A static cursor allowing forward and backward scrolling of a fixed, unchangeable set of records Const adOpenDynamic = 2 ‘A dynamic cursor with both forward and backward scrolling where additions, deletions, insertions, and updates made by other users are visible Const adOpenKeyset = 1 ‘A keyset cursor allows you to see dynamic changes to a specific group of records but you cannot see new records added by other users Const adOpenForwardOnly = 0 ‘Default, a forward scrolling only, static cursor where changes made by other users are not visible ‘Variables Public Rcs(2), NbreDossiers Dim SQL Dim i, j, k, l, m, n Public NomDbAccess(1), ObjDbAccess(1), Db(1) Dim ZSUP(20) Dim DateMAJ ‘Affectation des variables NomDbAccess(1) = « E:\ApiBatiment\v6\APIBAT\Batgest6\Exemple\Batig.MDB » NbreDossiers = 1 ‘************************************************************************** ‘PROGRAMME PRINCIPAL ‘————————————————————————– Call OuvreBases Call Societe Call Chantiers Call FermeturesBases Call CloseRcs(« 0 ») Call CloseRcs(« 1 ») ‘************************************************************************** Sub Societe ‘————————————————————————– SQL = « SELECT defste.TXHORCHANTIER,  » SQL = SQL & « defste.COEFREVIENTCHANTIER  » SQL = SQL & « FROM defste  » OpenRcs(« 0 ») Rcs(0).Open SQL, Db(1) End Sub ‘************************************************************************** Sub Chantiers ‘Sélection des chantiers Etude ou travaux ‘————————————————————————– SQL = « SELECT ChantierDef.Code As CodeChantier,  » SQL = SQL & « TXHORCHANTIER,  » SQL = SQL & « COEFREVIENTCHANTIER,  » SQL = SQL & « DATEMAJ,  » SQL = SQL & « ZSUP1,  » SQL = SQL & « ZSUP2,  » SQL = SQL & « ZSUP3,  » SQL = SQL & « ZSUP4,  » SQL = SQL & « ZSUP5,  » ‘ SQL = SQL & « ZSUP6,  » ‘ SQL = SQL & « ZSUP7,  » ‘ SQL = SQL & « ZSUP8,  » ‘ SQL = SQL & « ZSUP9,  » ‘ SQL = SQL & « ZSUP10,  » SQL = SQL & « ZSUP11,  » SQL = SQL & « ZSUP12,  » SQL = SQL & « ZSUP13,  » SQL = SQL & « ZSUP14,  » SQL = SQL & « ZSUP15  » ‘ SQL = SQL & « ZSUP16,  » ‘ SQL = SQL & « ZSUP17,  » ‘ SQL = SQL & « ZSUP18,  » ‘ SQL = SQL & « ZSUP19,  » ‘ SQL = SQL & « ZSUP20  » SQL = SQL & « FROM ChantierDef  » SQL = SQL & « WHERE (((ChantierDef.Etat)=’E’ Or (ChantierDef.Etat)=’T’))  » SQL = SQL & « ORDER By ChantierDef.Code  » OpenRcs(« 1 ») Rcs(1).Open SQL, Db(1) ‘————————————————————————– If Rcs(1).recordcount > 0 then Rcs(1).movefirst For i = 1 To Rcs(1).recordcount ‘Prévisionnel ZSUP(1) = DEVHrsPrevues(Rcs(1)(« CodeChantier »)) ZSUP(2) = DEVDebourseHorsMO(Rcs(1)(« CodeChantier »)) ZSUP(3) = PRPrevuCalcule(Rcs(1)(« CodeChantier »)) ZSUP(4) = HTDevis(Rcs(1)(« CodeChantier »)) ZSUP(5) = PRPrevuCalcule(Rcs(1)(« CodeChantier »)) ‘Réalisé ZSUP(11) = HrsMORealise(Rcs(1)(« CodeChantier »)) ZSUP(12) = CdesFouRec(Rcs(1)(« CodeChantier »)) ZSUP(13) = PRReelCalcule(Rcs(1)(« CodeChantier »), ZSUP(11), ZSUP(12)) ZSUP(14) = HTVente(Rcs(1)(« CodeChantier »)) ‘Date et heure du traitement DateMAJ = «  » If len(Day(DATE)) <> 2 then DateMAJ = « 0 » & Day(DATE) & « / » else DateMAJ = Day(DATE) & « / » If len(Month(DATE))<> 2 then DateMAJ = DateMAJ & « 0 » & Month(DATE) & « / » else DateMAJ = DateMAJ & Month(DATE) & « / » DateMAJ = cstr(DateMAJ & Right(Year(DATE),2)) Rcs(1)(« DATEMAJ ») = DateMAJ Rcs(1)(« ZSUP1 ») = ZSUP(1) Rcs(1)(« ZSUP2 ») = ZSUP(2) Rcs(1)(« ZSUP3 ») = ZSUP(3) Rcs(1)(« ZSUP4 ») = ZSUP(4) Rcs(1)(« ZSUP5 ») = ZSUP(4) – ZSUP(3) Rcs(1)(« ZSUP11 ») = ZSUP(11) Rcs(1)(« ZSUP12 ») = ZSUP(12) Rcs(1)(« ZSUP13 ») = ZSUP(13) Rcs(1)(« ZSUP14 ») = ZSUP(14) Rcs(1)(« ZSUP15 ») = ZSUP(14) – ZSUP(13) RCS(1).update Rcs(1).movenext Next Else MsgBox « Aucun chantier n’est actuellement en Etude ou en travaux  » End If End Sub ‘************************************************************************** function HrsMORealise(CodeChantier) ‘————————————————————————– SQL = « SELECT Sum(SuiviMO.NbH0) AS HrsMORealise  » SQL = SQL & « FROM SuiviMO  » SQL = SQL & « WHERE ((SuiviMO.CodeChantier)=' »&CodeChantier& »‘)  » OpenRcs(« 2 ») Rcs(2).Open SQL, Db(1) HrsMORealise = Rcs(2)(« HrsMORealise ») CloseRcs(« 2 ») End Function ‘************************************************************************** function CdesFouRec(CodeChantier) ‘————————————————————————– SQL = « SELECT  » SQL = SQL & « Sum([CmdFouLigne.Qte]*(IIf([CmdFouLigne.Remise]<>0,Round(([CmdFouLigne.PA])*(1-[CmdFouLigne.Remise]/100),2),[CmdFouLigne.PA]))) AS BCFMontantCdee,  » SQL = SQL & « Sum([CmdFouLigne.QteLivr]*(IIf([CmdFouLigne.Remise]<>0,Round(([CmdFouLigne.PA])*(1-[CmdFouLigne.Remise]/100),2),[CmdFouLigne.PA]))) AS BCFMontantLivree  » SQL = SQL & « FROM ((CmdFou INNER JOIN CmdFouChant ON CmdFou.Code = CmdFouChant.Code)  » SQL = SQL & « INNER JOIN CmdFouLigne ON (CmdFouChant.Code = CmdFouLigne.Code) AND (CmdFouChant.Id = CmdFouLigne.Id))  » SQL = SQL & « INNER JOIN Fournisseur ON CmdFou.CodeFou = Fournisseur.Code  » SQL = SQL & « GROUP BY CmdFouChant.CodeChantier  » SQL = SQL & « HAVING (((CmdFouChant.CodeChantier)=' »&CodeChantier& »‘))  » OpenRcs(« 2 ») Rcs(2).Open SQL, Db(1) CdesFouRec = Rcs(2)(« BCFMontantLivree ») CloseRcs(« 2 ») End Function ‘************************************************************************** function PRReelCalcule(CodeChantier, HrsReal, CdeFou) ‘————————————————————————– If Rcs(1)(« TXHORCHANTIER ») <> 0 Then j = Rcs(1)(« TXHORCHANTIER ») Else j = Rcs(0)(« TXHORCHANTIER ») If Rcs(1)(« COEFREVIENTCHANTIER ») <> 0 Then k = Rcs(1)(« COEFREVIENTCHANTIER ») Else k = Rcs(0)(« COEFREVIENTCHANTIER ») PRReelCalcule = (((HrsReal)*j) + CdeFou) * k End Function ‘************************************************************************** function HTVente(CodeChantier) ‘————————————————————————– SQL = « SELECT  » SQL = SQL & « Sum(IIf([Facture.Avoir]=0,[Facture.HTNetFin],[Facture.HTNetFin]*-1)) AS FACHTNetFin  » SQL = SQL & « FROM Facture  » SQL = SQL & « WHERE (((Facture.CodeChantier)=' »&CodeChantier& »‘)) » OpenRcs(« 2 ») Rcs(2).Open SQL, Db(1) HTVente = Rcs(2)(« FACHTNetFin ») CloseRcs(« 2 ») End Function ‘************************************************************************** function DEVHrsPrevues(CodeChantier) ‘————————————————————————– SQL = « SELECT Sum(Devis.TempsMO) AS DEVMOPrevue  » SQL = SQL & « FROM Devis  » SQL = SQL & « WHERE (((Devis.CodeChantier)=' »&CodeChantier& »‘) AND ((Devis.Etat) In (0,3))) » OpenRcs(« 2 ») Rcs(2).Open SQL, Db(1) DEVHrsPrevues = Rcs(2)(« DEVMOPrevue ») CloseRcs(« 2 ») End Function ‘************************************************************************** function DEVDebourseHorsMO(CodeChantier) ‘————————————————————————– SQL = « SELECT Sum(Devis.TotalDeb – Devis.DebMO) AS DEVDebourseHorsMO  » SQL = SQL & « FROM Devis  » SQL = SQL & « WHERE (((Devis.CodeChantier)=' »&CodeChantier& »‘) AND ((Devis.Etat) In (0,3))) » OpenRcs(« 2 ») Rcs(2).Open SQL, Db(1) DEVDebourseHorsMO = Rcs(2)(« DEVDebourseHorsMO ») CloseRcs(« 2 ») End function ‘************************************************************************** function PRPrevuCalcule(CodeChantier) ‘————————————————————————– SQL = « SELECT Sum(Devis.TotalDeb – Devis.DebMO) AS DEVDebourseHorsMO,  » SQL = SQL & « Sum(Devis.TempsMO) AS DEVMOPrevue  » SQL = SQL & « FROM Devis  » SQL = SQL & « WHERE (((Devis.CodeChantier)=' »&CodeChantier& »‘) AND ((Devis.Etat) In (0,3))) » OpenRcs(« 2 ») Rcs(2).Open SQL, Db(1) If Rcs(1)(« TXHORCHANTIER ») <> 0 Then j = Rcs(1)(« TXHORCHANTIER ») Else j = Rcs(0)(« TXHORCHANTIER ») If Rcs(1)(« COEFREVIENTCHANTIER ») <> 0 Then k = Rcs(1)(« COEFREVIENTCHANTIER ») Else k = Rcs(0)(« COEFREVIENTCHANTIER ») PRPrevuCalcule = ((Rcs(2)(« DEVMOPrevue »)*j) + Rcs(2)(« DEVDebourseHorsMO »)) * k CloseRcs(« 2 ») End Function ‘************************************************************************** function HTDevis(CodeChantier) ‘————————————————————————– SQL = « SELECT Sum([Devis.HTNetFin]) AS DEVTotalHTNet  » SQL = SQL & « FROM Devis  » SQL = SQL & « WHERE (((Devis.CodeChantier)=' »&CodeChantier& »‘) AND ((Devis.Etat) In (0,3))) » OpenRcs(« 2 ») Rcs(2).Open SQL, Db(1) HTDevis = Rcs(2)(« DEVTotalHTNet ») CloseRcs(« 2 ») End Function ‘************************************************************************** Sub OpenRcs(NumRcs) ‘Création des recordsets ‘————————————————————————– Set Rcs(NumRcs) = CreateObject(« ADODB.Recordset ») Rcs(NumRcs).CursorType = adOpenStatic Rcs(NumRcs).LockType = adLockOptimistic End Sub ‘************************************************************************** Sub CloseRcs(NumRcs) ‘Fermeture des recordsets ‘————————————————————————– Rcs(NumRcs).close Set Rcs(NumRcs) = nothing End Sub ‘************************************************************************** Sub OuvreBases ‘OUVERTURE DES BASES ACCESS ‘————————————————————————– For i = 1 To NbreDossiers Set ObjDbAccess(i) = CreateObject(« ADODB.Connection ») Db(i) = « Provider = Microsoft.Jet.OLEDB.4.0;  » Db(i) = Db(i) & « Data Source =  » & NomDbAccess(i) & »; » ObjDbAccess(i).Open Db(i) Next End Sub ‘************************************************************************** Sub FermeturesBases ‘FERMETURES DES BASES ACCESS ‘————————————————————————– For i = 1 To NbreDossiers ‘Gestion ObjDbAccess(i).Close Set ObjDbAccess(i) = Nothing Next End Sub ///