From 066e4b68f41f28fc3f2370792172a32bd5254717 Mon Sep 17 00:00:00 2001 From: StillHammer Date: Wed, 31 Dec 2025 13:43:30 +0700 Subject: [PATCH] Add VBA source files for GitHub readability MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Export 7 VBA modules as .bas files in src/ - Add form button helper functions (GoToNewRecord, DeleteCurrentRecord, SaveAndNew) - Export frm_Accueil form definition as text 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Opus 4.5 --- db/TimeTrackPro.accdb | Bin 765952 -> 864256 bytes src/forms/frm_Accueil.txt | Bin 0 -> 14890 bytes src/mod_Calculs.bas | 134 ++++++++++++++++++++++ src/mod_Config.bas | 51 ++++++++ src/mod_DataAccess.bas | 236 ++++++++++++++++++++++++++++++++++++++ src/mod_Export.bas | 102 ++++++++++++++++ src/mod_FormBuilder.bas | 212 ++++++++++++++++++++++++++++++++++ src/mod_Navigation.bas | 104 +++++++++++++++++ src/mod_Utils.bas | 111 ++++++++++++++++++ 9 files changed, 950 insertions(+) create mode 100644 src/forms/frm_Accueil.txt create mode 100644 src/mod_Calculs.bas create mode 100644 src/mod_Config.bas create mode 100644 src/mod_DataAccess.bas create mode 100644 src/mod_Export.bas create mode 100644 src/mod_FormBuilder.bas create mode 100644 src/mod_Navigation.bas create mode 100644 src/mod_Utils.bas diff --git a/db/TimeTrackPro.accdb b/db/TimeTrackPro.accdb index d58ebaefb76aa9150bdb1624a057abff44a53cd5..8872032b21d1d9034db07fedf8344545c413b60d 100644 GIT binary patch delta 11838 zcmc&aX?RoDmG?bu?|GFsSq5W2Y!>4Uc>xv&30W8^;vB0*BWPwTANG2o@ zNP=k_ZZgRZ>FJX(qz(^Va|E)Nwx{;%)hz% zqXd@FVT%#3Tm^vxI!|?*XDDSiYc1 zt*WIz65em5x3?$_^y*XUm~Sr{iABtM;`l0`^>AJzdxnAvuwwaSLv%+ zOa{xnzVC7t6S|zm<{ehKLD_F<+Htlx<2g~Y^fM0*Z92|g%1YW3hQ2wDB{nqR>Q%+z zqpPu-4fvxDojJ?4Dd@pB*uM^)A;hsV5G3SP01ODc20#e{X8|Zh;2Z#D2%HC?9D&yX zScSkF0IWvfO#mtocng3^1l|T<4FbOfU@c|dVl8y)O?F?X>Mi!q39Mr!Ex*KWNq4M8 znWVs=d*G(lrV*cmA=r>UdWl`mIx6Vvm)K>jqnv&Tb&_OZa-gN#Es9mrk`Iu*igt^2 z37r({Qu?S^ucqh4x-9e`AF#*bRpMyr^j}$1AZlJx)J6o7@h9pF5sNxR#G+miv8ZcA zEb1Q-i#kcfqMj15H37djiS)MPOnb*@kf`#vvFhCVM)#l9JLnk@kLVYz`&ZCI6e?`rjG{WF^Nnpf2A z>I6L@tU?1pb^L%PBkj8ngYt|LUvqv5w1cUIcGP&6 zMyCMJ(_kmRhAz5G!!5k*oiBbS1H@0yiZkcw#=Ai6iQ)O?>`no>Q*-3b(K9G_%iw%{ zKUoTLFU^rVOHFr!T$N+KoZk#`;W=`z(VwDRe9wHj`TV7Z#?2Wiorr}x<_MRenS@@(4_3k=hUHmPV>&LxDyGHIO!4NWNqNp zL|>xs?El9HMnOpE*FjB941Mx|#{a+nbfAa@e_HUTX`la)hWZb2cgHo7#!gcsD%6YP z%8CC|LMYxJ_afJ=tWz8~e6)c{3%x+O1jbfUT4E@zTvb_SU1gd3&54hxvYBtpDJ?Hu zU1F^$Ed`;{GU*Gv8q1A2Wvk1|4VDUv!Lr6uQoW`Mzt+&=`#B%WY^C=;z%?imMt6kX ze}G%U1UN!U_B{M{A|bl0JxV5~a8FmgWARISv;}+E48jK$lUqo~xO>=FLy{k7G|DX< zq`RiQt=ej~k?Q)6j{4e0i*}>6%W_+B6X{3_E^Q+1q^OD1 z#0OW@gxSe5D=`!6WO2Qb>mc=k;EF~+so6+Yc7++H`e1RVJ?l`h_O}O%6ZRHY5$Cwm z)Zg#&9SpBDC6Bzg5-3K4;3Ou}ZzL|F_8E!7*;;QiH;~4vp8C4Z`VLanvC(91ZLSG+ zZS1Z$_taZT^IOAtws2uXxU7mC>oF?oNT-qMAkN1+NWf(Zt6PHuHN?4gV|Yz{SYhH@ zO7AOQ(Ng;6hYh8%Rizf^&~U$h(y3#VdrK^7!IEKO@bB;IY_gHosxGs+&SEC!)~ae# zO`V-sn(Mn88tnFCjS532X(F3ig9Y2Vg3HXt{g&q$ld`%aSXEYT%_kaczP6HP=T3Le)?==ki>=m@W`}-f!7+!a)GaI=-CJ+!BsO!8y`imY zBeB>ztD0;*W@4*rXg6EBO+RjH%FQs5m8Oy&A@#8aM}Jj#rNyzZ)3LC_nb|Y5z&4%H zU~Dq~L|D*0y|8UMdu7HSt~dj6RWBA~e1ErfV$7rTjz7NJN+!ryyd&Kku2BqXKQ)@}9LuZ{yeas># zERJ+r&Mi%ShHd8Qo9mD7P9+DQ-2I8}iO17PCONvh+T$f7=78TlJmB)$Ym7lcR3+8V zr;ntC6aC?m;ou`K;$^Bz+D$zhyQ-^+ePc^aN42$!Gs3TzaTpUwUVT*64sm zm_}0R&Q#Tn^bbe*opdZoWeeSNm|LyBW19QvG|x`QjcX$7b%nTIm(g-#j1cR2CGvTb zIvp{`sPS%I8R`-^H4}<8$GoDVN1J29baPeA1)5#RJ-csZeN1R&ee8Kx1;Z%C9DolI zhNOZKP@W}((J2Uf1>hWwxLYB|VFz&)iVg5{iL}C|Du(Cji5zAPeQ1okmkO<_Epd5b z^VKmZNWYuJ=jY+RgOHO7(8$cdF6*PILbei~cbu%Q7L=j{HMFVp`j4gz>=1A(K@xRb z%PnW`1Fr3BxRvZF;10=L>ouC!v0ngp`g(2G#glgTh^yV}?B6cfyq>EnQc`RvHh@1Y zYd1w%n=mN7<32(Pl8x+yG&BeOgI%>Y3(}Tc?ji(6OGs?8nZ+@Hm?*P^QPRKksZ+`| z@N|xpy|OS0qVqnQ%41<4O3?F2yVe2uz=QHN&MRgOz!a`GL~v~>>i}-;*Kk*}Q^0k| z-0Ewbx0Ve9ckFB0t``S-@_JkYT7)CQNymZ{7={|B3MXU;zBtl%U`%KMJ>I5D%@@#X zfFUPR*xQzg{Qy~{9~a$Bi`!JXB$QbMblh7Y?4Zn`Ivs zZcHLg$}K8^G%dHt0r(ve4*jA-^(~fthoP-qDjkG7b$6-C!J*&nQe{JOpwD%wmK4B5 zK-s+HXY#y!#$lu&K7W2b;~X@hTUC&Rf#n)>`Zq6mf-vMWZi?1-s~R9BP};2$m@qvF zQc4WDBhPR>G?2$@LbW|AC#z+c-nd9!Wr!#4#L@n^(4(7F8x{1lM^(A%IvMhpb28-b zVeP|tE}9`Z9#T{mtuS)`mkgPSPKJ3^V}`sBehZRo*$I&bdE;3Vw>Du;ZefUmD$QJ> z5?YB_rI0$zT*9>?-#`%+E3jEWLA=x>{N9Cq3|l}1*0X~?XaNN< zBDsj%OBQZPDlUpK(Ow5T1AVDbIf7Lg@T@n|Y zyhqG5F%doV3Mv9aT342@h zyi|tn03H8ZDx>QL)f~NIS8<1rYpJbGrQ{|+b1ZzQ5z;2L)o_ONb1)N;a{ZK%MD~Ns zKS&vCzM3);#FP>GuNrPU%iK=g_1t!--jXU)17e{k8@Nx|BQ`Eg0kdKxear`~z@bRM1(Jfpr6FM@?c@-YE4TK@m^zJlp8nug?ggN13vfqRM>1s^ zI2|a>V47nSkjuVELO*

t;gw71*qbsS4d479nY8HUWWpI6YrHdSRH zB6U4|IDuHMKtddYFB(`2Go^C^J$qIKwnci@ZtBQH|0YlLxzaot^0XiJ+)g^w65 zT27O8aEs~iA2|aoxgcnYEIEa^a>zx((n+$6ZLD-?7-QgIOmj%7O}~C(`kh z1as(}X_=0l9S1m~^dv)D+-lu|u*}D6-&1q=mu3DHnU90`Vh&%=itX2n3pXeYUfjFG zz%bkl*dYuI_xDB#R${<*0UWVmNYW86Zt&%H6ZCgFeqq226Nw3BN^T0FARh8?h0q%KZk278%ePD#CC_*a(#%!5oee zH(xkLR5~WhU_ZD_BJ|)K`u;ia6vDEh_sMiT+f9pbBBw;9xUNJ?Y0{s#l&Di?WO=mh zvJ9g=S7aC+BzgdBMm4xmMElV;0b#jcT&hSnKxL3&ly?9eanKOJxPssrkpkd3h?5xz z?sE`Z??6p2X7V{%H;TmrO&sG>{=^~2r!c<5knp% zqhJg@mc{3n!J>t>sKWqtM8`XT>*2eZe5S;8Ft;tC4`uNg{Boj(aofO_x0mp_36d=X z(B>p08+vF$t;@&0fey6o@SOrW_Ol=ANI$rIil9)sjL)hlDiX-gqc$QPae@3dn?qt0 zD@dFI^%!J5c~Boog@r;L-%+Qhe!-fJ*kOx*rx&~V0>YjyU%}@jprWE8q@6-qZ$6*J zLYIMjUKc1TVi|!fP%zAIfR6>`CP3~;su+JT^i;)SqEncS0*v=d7WrMs*NgE6FJByr zTEO3c516YE;3mXuJgHEK11l=}xpF!ADYU#9+6f@{J&@N!{WHQ5D;?UQP6>>&KO-8_ z?D6k(IsL?B^s)+K8FssVPNb%8X!;Ih)gyY0Onl$tP@Dq%XK;+~^uX-iT(r~U_X$4# z*q9gYzPuX*ax3`l8*D7d@WkR79dvtvPL>eVEs!9qf+!G37|pF<&Bk9U7&72TTc3q4 za2jz7hz1~zZtnsd$6$jR#{k=7=MMD((RiM;MY@*FhjGho-OvV4(MR-R+>6G40XbVB zFUr2czJ1s6-+e5mcC_hvumSrH0|EO!3AN}yua|Dyp-$>S55^MfsModC?Hl*PNF^_# z5!e`wn1DvOq%ikjJ(ecbgfRC%Lrml2UU#2=oMCR7bAPZM?hhPs^veRiBEYB}aA!E| z?st>%_?Y+@o4=1CI-$+qC$x+a*C^aMkC^&Nzu)B^&RY?$j1dT_@>oU&*kVFrnMknPsd0cKrly(I`UJUZ^nQyexrhXwQQPNM2(SY2I}VDbr#mp!9f$x8$jo#KinZP*We2XVr_bw>5yZVX8JK%GT7grPa=s>mG>l=Si z$WbH&jlqY6W$HZ3ZMl=~y21FE2S#jKuVm|Qto;aA2WY!4Iev`UTXe0ezmus}x)PHW=z0)AxTi}O+%hq%WPR-cikDx_wH`xtNo+KY~mReYCP?p<|VFOFYL}+aWup1(Rzkm&W8gnqk_Zg z^?JOl%EZ)$1J2QbVVAdmfu-+{PENrcb2$4IF&1S^T#2!&-RpP!z_iFZai4o!P$dOZ zz21RXc5SYv$+y+)nNSKjGl_7ixK>c-7!Np@;sKYhU+HxpJ5ea??6V3J{lm_YV?Qnw zNRFHZ{(7nV?!;=R+529NCh_H;Oj_B1P~{qSja%!odvlM*HRlS46#BfJP7+!FB$5CG zF#|a6*x48CcKMn;LP1z>X!W~%%o&H?;+eu+;85nQAj@j@DF5xm`^9$u==AxKtE6#zIr0+KSmyufRMbn*#22OZgB~7fSh~a7jN|#-}j?rDgp2CAeY4g^vXvJduL<5Q~@h3in=bZ+?Z(ACwaHuJh;{ZDuhQJx@;*?!c3xh_3v6unEK}hdgE>3kR@CHfZ zUBeZSng_Diavghn6tJlvw5w0u36~j9_o+?N%Z)TMdBpj ziwEG$y<8IM8kiL+B1QDf)3Qe!oTv zbhIlB|A5=0h-k-po{s{0n9;c&M2U#5%d*bnAcOQ7u%Q;d;x-O=K?s?Mf2RP)BDMz^ zwfK=}_>26A4y@%8dleNTGNHs*0-1FEpt?9Yg*<|xEZ+JPav?^#&<_o&3vQI};1_Nr6tI1e{Ue@K7b{_Yw%;BRc^hz6VPWsCG5^8DZ^Vzo(siz&-U%4Bl&$sh=Y-bkzH(>EgRA8@!#uVuP?Enc4Ky4!%B7dVM1a zf68Xk#Sd_c=(bKik^Ms=y`__{=c5wzwN5ZNHI;tZ2?keO+Z%1#$d@PHxl{@(JTSmn z484?#FUt&?MT5alRZ11h=uv@LQk7-G=%xG$> z>9w>pSJ&B_daJCB)^_WD7`-;4WD#TJ820dvA@k*=nz|bnTtByT&zc8XIeO zkAwSuH>;jzZ{l-wq7%jcyS&LuP4Fp1TQ~8U8c;4Gqnr5bD00sxUY{>>>U^EfVfTP_ z#OWS>?$=tPQo0aa0G`J|h>c&|#IK7sW;XM>D5BrYmqd~J&HSb)^25!%5JgUH=F6kV ze{JShEEH|7iu_f^ck)|W5(C{~Fw+~h@IxpqA`fqo^oYnyTliqE%n`ROE+Kib&ZYUl>IkgZzRha?2oJYLUfY zlAAoEX;hzXpVbGvTG;8id`%v=&*JfWL23x%T_5S<-9dg)RO^2Z^0`q&*vh9% z{>H!QY;}&iJ)=j?NI?z>n9#k!`( zMeZHq3!=!chWPw+(MQt%B7SsI>KAq$g#PCc|0qg|$Pe87tx;s@Hhu_RRot_U|0UA! z7K1iz=X0XS*mgdxSLT@U?>Kl$lDy{o-pA4k!&XtAG{HXAPb8PlHkPKd1_Bu7Yb$dIT_kZCxX>g;b8g}YUfMpPk( zESydtW~C-~dS(^DhS}m78G!?V zIW$3*)L=cRgZDEGvlsspkVcgrJ`hL}pMF}E3LbblL|_QC4VvJq1%i?oQ(@@~!61RF z9LVihf|v}%VuWADXiDbc?*yzM0A_?gFHC~Jp{=wBfC@?wbTA|j6ma6xU!;Hx!z_9< v`eqLdIXD0F3cTs_Y3BSziNar$7KEN&%KexLX=`KpnUKm9BQUd+Ugm!QHi&C_ delta 2358 zcmb_ddrVu`8UOC}^#hxCD8wPS4&=cj@e>ea%5q<}@rzs=Y;31vc7ZOWuuu$?ER%dm z=}d^yfRgBF+NPN(tq5sSl5Dk9O_STPRLh!>u8FokHZ5x@tF&s>wo2JLt=YL3L6b=P zZ}+?Be!oxWcfRwTpT2vqc)wA+Z(1Y^i5u5T3O^&x7z+!p72hnHT`WODhmt~qOH+)D z0cFWG<43;P*DUDa6_xf()u8U`YjG0oPf>f(R+`XVzjfr_SCo@&_wKxfZW#zYS#u%% ziGj#|Vjyd0mAwG)YxLA2Y0_W8aQ%7=XP;RlR}9(@b4w&>zW6L9%+BqT^6!@(s_c8q zWQXEVAHevwlnC%V2D>CMgu!kJynw+T2@GRkl0Xszvjj#kut;DO1FHnaFtADBMGWi` z7{_;`1dd|RgepHEA0XvDazC26OQy5@J@T)Gb}cN-igtzbyRn_PU)YJaK!?Y74Iye7)dT`JMTH)J^MLx_@dfYcJpY z|Cn5J_FYl!(xM|L)n(}6D{7Upm;hRfZYxwnEuKm zblg|yZ=H`6^5lvt2CqnewSss7y{E#3ES5Z;d2bEoO+LaKLT{>7H3jQDxuejkT4f=g zM~oV0_~?UA+ay`jt83m+j5CA)UjD%^0kw?2SOoFn~&>q@Dc7MlOICj4nGf_u*VNBvChTi$O*dxSeP(*0<S)l@B>__m z^w9WYmZX7DBmy3R_4;^-dE8-7hz~&*!v@-2k*-YC!^S+EEs(377IM42IXfoNig`DL zX(9xP5cH)Mn4Bsg_PQX^m1{M4atbEz?Wesq+73bR+wQJ z&xzInu#8SU8}@?`;3F*S=741bypwUcA;`6RqF!&15Be0AF!Nr3U@0M;+tELq~>3E**8?{}c?x zD~59(g}W^T;fNskx}u%X7GNC=7vaDycm;nj$Sxe9+-=Yu7J0!~KJ7DBL^EY=5QvvA zIPRBmMg#@`mEeg2@!)y7#ne@d6f z#LW?LhB@0s&Mbs7gah>Lbd}FY#r&CLVcPw+-jxyC+%x*Q?WgsdZ71}_1dYFVM4HHG zvP342$mH)+tiQ!|@=s$YYNWNs{1#=)FW2lxirKk2M4!r|vJs<3MW7$n7HrAxV6|^3 Zv!?oj9~0=+cJ0s7W{);&_UPX4`!D~v^yL5m diff --git a/src/forms/frm_Accueil.txt b/src/forms/frm_Accueil.txt new file mode 100644 index 0000000000000000000000000000000000000000..423a1b5238863093a5c8d6724349e5d66c5c1f7e GIT binary patch literal 14890 zcmeHOU2oeq6y@`P{Rd-D8?X)XS7JZ(p-I;@K-UIM+G3BgET>tMI7{5F*^l3L4(U6R zl0}h`+q6X>q?9G{^74M1dwHq;`_C&?sw;J^PSsLfsGfSD2CA>VRo^K8%?tGVQ@umK zE8NZ3Ju}_&5YK1o4DYVh8}(dWs+B{}P}|3wQWfeg`n*%;di+nAX-8$4af-j8o_SYO z+(X|J&>%;T!Pyl?kf+}IA~%J8K37M$KhwWg`pLDX-BZu-Yo#9H%|hjv^9;XS8qe_b zJ?1z;EBx-E-wGFH5liP0Xpqia^LwJ6>b8s?{}7y=VaC5Suhhf|W~aPzv?t&{o)dSi zuRy5;RqE8}Nu+lS$}=sI9Fl#EU+3t1rfxR$J;a*=5_zZfPF@Xv=b(Lo=f+}OxjxeJ z%)vD^UZT&h7)$wZ>;;}&E9#f)qui)nQW<*MkuksPcm2u=UTb2I#;%&+^5wjT8I3g=d*20* zV_d1y+6Nt4h>=qt6b4xH5NqB=>ryj*afF@)tjTDnr=@MY$?Yra&9J^HWH5wHWVkE! zT@Kn4-0y&Ae^tLgigRz)U)4)>fcdD4nAv8U>KyZoL8;L5?qcQwzef1W@q7x&kMy$) zZH_x)L?0YYyt(V#(64EozoEU1<|#w(0#}BS)KRwei?rR#pQERK^w#BS#~qb&?`pd) zr+qCSK|bp4J9P}JrtFSkL6pZ^$nOyMOT2TbHG7vx-_U!gW5E(0?~i|sd5Fi1JoVhz4u)~O1VLoxR4&ucRs*T2LX?b{xF zgmjqeZ0c!87~4F8t=#BY>y{*ar9B4K59lwN3TFf|N?I93pZXh=j79pZl)losmSydp zBPTj4j1hgRaaqPnD>mbg-_av8(3ww!SUnrFAu8IkKzrdGftbXh`eRIt9X*OoS1y>N_$Td;eC`ri*`c@1D{Em5 zfi&v%3Xy`eK9#Pk@u~TdHwMkDGz3?zRMX-^ol^VS!U(;IqSaW;>U`;RUEyYGU02ye zHEyMG85HZstZ>l0#>6}h#0JX_!SZH0BKWdYBEMzR`d$QkQrtg zA)3${h$RzvCZCUhDmivX+)rkB!s;J0QTAc|Z;q!SIW)^vIC!Y@(B+0&Ylv?19^Cgk zRzRC7Ey97c%{1F>Go0BsQ}&T&Q^i2Ilh#J!w)#hyC%ZEU$=S|oPg&xs3o=sL=j+(T zYTG612W(Fe1Bi|jXeovZq4gA&w{UifVH=cD(y}gQs=bVuX=DBUjMQaQc&{TvDi4x7 zxci+!;yQ#zb^pWtS(-$A)UvjbwV;-0L)tDiW}(s4c0tH0O>+iPY8+(#PTb7V5*_(B z(pb9CNJ-3`0aJOl#nXxjMon;+VlV9oTIG;BxPgsxe^03vy23a|Rj`ZKG*Rv1O-(eb zUS|9(MQTlytKP?RxHx-{*MmjYp3ZL5Yc5rdeva5l+mDrf z<*HAaDs3DpiX}6TnBg>w)n%T&@(gy4i@Ps==VBvIxZ)-Bqz%)xv1gl9tKVy+SX!80 zRVwH{!_pys!d>^|6%j&J0!KCjwZ0usDoNk}|B6fvcJZoilvuoNE zyV7#5Q0y8e#+psBi(ggo3o7otm@V+@wabqb#oW2rkh;IJXM75jWHBtR^(QK$Qllz^R`6eta zSH6#C^(ZD!x_O)Rsv(f&Yl&w5H_0NYrZyDKMq7wxPjoC>VK>JA55xaWRVGr6+mCIU z=kDVe_g>s17l=u$8Wz}bEwB$`y^v9iUp<*KXx1M2zd+0h3#*EYuR4z1#^XMRI2M1- kA|4mUZx_MR^3X6{i*4Ja`sGy=ZFVR6khcEDJ~4Oy0ra%CsQ>@~ literal 0 HcmV?d00001 diff --git a/src/mod_Calculs.bas b/src/mod_Calculs.bas new file mode 100644 index 0000000..72dc2ba --- /dev/null +++ b/src/mod_Calculs.bas @@ -0,0 +1,134 @@ +Attribute VB_Name = "mod_Calculs" +Option Compare Database +Option Explicit + +'=============================================================================== +' Module: mod_Calculs +' Description: Fonctions de calcul et agregation +' Auteur: Alexis Trouve +' Date: 2025-12-30 +'=============================================================================== + +'------------------------------------------------------------------------------- +' Function: GetTotalHeuresProjet +' Description: Total des heures pour un projet +'------------------------------------------------------------------------------- +Public Function GetTotalHeuresProjet(ByVal projetID As Long) As Double + GetTotalHeuresProjet = Nz(DSum("Duree", "tbl_Temps", "ProjetID = " & projetID), 0) +End Function + +'------------------------------------------------------------------------------- +' Function: GetTotalHeuresClient +' Description: Total des heures pour un client +'------------------------------------------------------------------------------- +Public Function GetTotalHeuresClient(ByVal clientID As Long) As Double + Dim sql As String + sql = "SELECT SUM(t.Duree) AS Total FROM tbl_Temps t " & _ + "INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID " & _ + "WHERE p.ClientID = " & clientID + + Dim rs As DAO.Recordset + Set rs = CurrentDb.OpenRecordset(sql) + GetTotalHeuresClient = Nz(rs!Total, 0) + rs.Close +End Function + +'------------------------------------------------------------------------------- +' Function: GetTotalHeuresPeriode +' Description: Total des heures sur une periode +'------------------------------------------------------------------------------- +Public Function GetTotalHeuresPeriode(ByVal dateDebut As Date, _ + ByVal dateFin As Date, _ + Optional ByVal clientID As Long = 0) As Double + Dim sql As String + sql = "SELECT SUM(t.Duree) AS Total FROM tbl_Temps t" + + If clientID > 0 Then + sql = sql & " INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID" & _ + " WHERE p.ClientID = " & clientID & " AND" + Else + sql = sql & " WHERE" + End If + + sql = sql & " t.Date BETWEEN #" & Format(dateDebut, "yyyy-mm-dd") & "#" & _ + " AND #" & Format(dateFin, "yyyy-mm-dd") & "#" + + Dim rs As DAO.Recordset + Set rs = CurrentDb.OpenRecordset(sql) + GetTotalHeuresPeriode = Nz(rs!Total, 0) + rs.Close +End Function + +'------------------------------------------------------------------------------- +' Function: GetMontantProjet +' Description: Montant total pour un projet +'------------------------------------------------------------------------------- +Public Function GetMontantProjet(ByVal projetID As Long) As Currency + Dim heures As Double + Dim taux As Currency + + heures = GetTotalHeuresProjet(projetID) + taux = Nz(DLookup("TauxHoraire", "tbl_Projets", "ProjetID = " & projetID), 0) + + GetMontantProjet = heures * taux +End Function + +'------------------------------------------------------------------------------- +' Function: GetMontantClient +' Description: Montant total pour un client +'------------------------------------------------------------------------------- +Public Function GetMontantClient(ByVal clientID As Long) As Currency + Dim sql As String + sql = "SELECT SUM(t.Duree * p.TauxHoraire) AS Total FROM tbl_Temps t " & _ + "INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID " & _ + "WHERE p.ClientID = " & clientID + + Dim rs As DAO.Recordset + Set rs = CurrentDb.OpenRecordset(sql) + GetMontantClient = Nz(rs!Total, 0) + rs.Close +End Function + +'------------------------------------------------------------------------------- +' Function: GetHeuresMoisCourant +' Description: Total heures du mois en cours +'------------------------------------------------------------------------------- +Public Function GetHeuresMoisCourant() As Double + Dim dateDebut As Date + Dim dateFin As Date + + dateDebut = DateSerial(Year(Date), Month(Date), 1) + dateFin = DateSerial(Year(Date), Month(Date) + 1, 0) + + GetHeuresMoisCourant = GetTotalHeuresPeriode(dateDebut, dateFin) +End Function + +'------------------------------------------------------------------------------- +' Function: GetHeuresSemaineCourante +' Description: Total heures de la semaine en cours +'------------------------------------------------------------------------------- +Public Function GetHeuresSemaineCourante() As Double + Dim dateDebut As Date + Dim dateFin As Date + + dateDebut = Date - Weekday(Date, vbMonday) + 1 + dateFin = dateDebut + 6 + + GetHeuresSemaineCourante = GetTotalHeuresPeriode(dateDebut, dateFin) +End Function + +'------------------------------------------------------------------------------- +' Function: GetNbClients +' Description: Nombre total de clients +'------------------------------------------------------------------------------- +Public Function GetNbClients() As Long + GetNbClients = DCount("*", "tbl_Clients") +End Function + +'------------------------------------------------------------------------------- +' Function: GetNbProjetsActifs +' Description: Nombre de projets actifs +'------------------------------------------------------------------------------- +Public Function GetNbProjetsActifs() As Long + GetNbProjetsActifs = DCount("*", "tbl_Projets", "Actif = True") +End Function diff --git a/src/mod_Config.bas b/src/mod_Config.bas new file mode 100644 index 0000000..bf95f21 --- /dev/null +++ b/src/mod_Config.bas @@ -0,0 +1,51 @@ +Attribute VB_Name = "mod_Config" +Option Compare Database +Option Explicit + +'=============================================================================== +' Module: mod_Config +' Description: Constantes et parametres globaux de TimeTrack Pro +' Auteur: Alexis Trouve +' Date: 2025-12-30 +'=============================================================================== + +' Application +Public Const APP_NAME As String = "TimeTrack Pro" +Public Const APP_VERSION As String = "1.0.0" + +' Chemins +Public Const EXPORT_PATH As String = "C:\TimeTrack\Exports" +Public Const BACKUP_PATH As String = "C:\TimeTrack\Backups" + +' Formats +Public Const DATE_FORMAT As String = "dd/mm/yyyy" +Public Const TIME_FORMAT As String = "0.00" +Public Const CURRENCY_FORMAT As String = "#,##0.00 EUR" + +' Valeurs par defaut +Public Const DEFAULT_TAUX_HORAIRE As Currency = 50 +Public Const DEFAULT_DUREE As Double = 1 + +' Messages +Public Const MSG_CONFIRM_DELETE As String = "Voulez-vous vraiment supprimer cet element ?" +Public Const MSG_SAVE_SUCCESS As String = "Enregistrement reussi." +Public Const MSG_ERROR_GENERIC As String = "Une erreur s'est produite." + +'------------------------------------------------------------------------------- +' Fonction: GetAppTitle +' Description: Retourne le titre complet de l application +'------------------------------------------------------------------------------- +Public Function GetAppTitle() As String + GetAppTitle = APP_NAME & " v" & APP_VERSION +End Function + +'------------------------------------------------------------------------------- +' Fonction: EnsureFoldersExist +' Description: Cree les dossiers necessaires s ils n existent pas +'------------------------------------------------------------------------------- +Public Sub EnsureFoldersExist() + On Error Resume Next + MkDir EXPORT_PATH + MkDir BACKUP_PATH + On Error GoTo 0 +End Sub diff --git a/src/mod_DataAccess.bas b/src/mod_DataAccess.bas new file mode 100644 index 0000000..2e690e1 --- /dev/null +++ b/src/mod_DataAccess.bas @@ -0,0 +1,236 @@ +Attribute VB_Name = "mod_DataAccess" +Option Compare Database +Option Explicit + +'=============================================================================== +' Module: mod_DataAccess +' Description: Fonctions CRUD pour acces aux donnees +' Auteur: Alexis Trouve +' Date: 2025-12-30 +'=============================================================================== + +'=============================================================================== +' CLIENTS +'=============================================================================== + +'------------------------------------------------------------------------------- +' Function: GetClients +' Description: Retourne un recordset de tous les clients +'------------------------------------------------------------------------------- +Public Function GetClients() As DAO.Recordset + Set GetClients = CurrentDb.OpenRecordset( _ + "SELECT * FROM tbl_Clients ORDER BY Nom", dbOpenDynaset) +End Function + +'------------------------------------------------------------------------------- +' Function: GetClientByID +' Description: Retourne un client par son ID +'------------------------------------------------------------------------------- +Public Function GetClientByID(ByVal clientID As Long) As DAO.Recordset + Set GetClientByID = CurrentDb.OpenRecordset( _ + "SELECT * FROM tbl_Clients WHERE ClientID = " & clientID, dbOpenDynaset) +End Function + +'------------------------------------------------------------------------------- +' Function: SaveClient +' Description: Sauvegarde un client (insert ou update) +' Returns: ID du client +'------------------------------------------------------------------------------- +Public Function SaveClient(ByVal nom As String, _ + Optional ByVal email As String = "", _ + Optional ByVal telephone As String = "", _ + Optional ByVal notes As String = "", _ + Optional ByVal clientID As Long = 0) As Long + Dim sql As String + + If clientID = 0 Then + ' INSERT + sql = "INSERT INTO tbl_Clients (Nom, Email, Telephone, Notes, DateCreation) " & _ + "VALUES ('" & EscapeSQL(nom) & "', '" & EscapeSQL(email) & "', " & _ + "'" & EscapeSQL(telephone) & "', '" & EscapeSQL(notes) & "', Now())" + CurrentDb.Execute sql, dbFailOnError + SaveClient = DMax("ClientID", "tbl_Clients") + Else + ' UPDATE + sql = "UPDATE tbl_Clients SET " & _ + "Nom = '" & EscapeSQL(nom) & "', " & _ + "Email = '" & EscapeSQL(email) & "', " & _ + "Telephone = '" & EscapeSQL(telephone) & "', " & _ + "Notes = '" & EscapeSQL(notes) & "' " & _ + "WHERE ClientID = " & clientID + CurrentDb.Execute sql, dbFailOnError + SaveClient = clientID + End If +End Function + +'------------------------------------------------------------------------------- +' Sub: DeleteClient +' Description: Supprime un client (et ses projets/temps en cascade) +'------------------------------------------------------------------------------- +Public Sub DeleteClient(ByVal clientID As Long) + ' Supprimer temps des projets du client + CurrentDb.Execute "DELETE FROM tbl_Temps WHERE ProjetID IN " & _ + "(SELECT ProjetID FROM tbl_Projets WHERE ClientID = " & clientID & ")" + + ' Supprimer projets du client + CurrentDb.Execute "DELETE FROM tbl_Projets WHERE ClientID = " & clientID + + ' Supprimer client + CurrentDb.Execute "DELETE FROM tbl_Clients WHERE ClientID = " & clientID +End Sub + +'=============================================================================== +' PROJETS +'=============================================================================== + +'------------------------------------------------------------------------------- +' Function: GetProjets +' Description: Retourne les projets (optionnellement filtres par client) +'------------------------------------------------------------------------------- +Public Function GetProjets(Optional ByVal clientID As Long = 0, _ + Optional ByVal actifsOnly As Boolean = True) As DAO.Recordset + Dim sql As String + sql = "SELECT p.*, c.Nom AS ClientNom FROM tbl_Projets p " & _ + "INNER JOIN tbl_Clients c ON p.ClientID = c.ClientID WHERE 1=1" + + If clientID > 0 Then + sql = sql & " AND p.ClientID = " & clientID + End If + + If actifsOnly Then + sql = sql & " AND p.Actif = True" + End If + + sql = sql & " ORDER BY c.Nom, p.Nom" + + Set GetProjets = CurrentDb.OpenRecordset(sql, dbOpenDynaset) +End Function + +'------------------------------------------------------------------------------- +' Function: SaveProjet +' Description: Sauvegarde un projet +'------------------------------------------------------------------------------- +Public Function SaveProjet(ByVal clientID As Long, _ + ByVal nom As String, _ + Optional ByVal description As String = "", _ + Optional ByVal tauxHoraire As Currency = 0, _ + Optional ByVal actif As Boolean = True, _ + Optional ByVal projetID As Long = 0) As Long + Dim sql As String + + If projetID = 0 Then + sql = "INSERT INTO tbl_Projets (ClientID, Nom, Description, TauxHoraire, Actif, DateCreation) " & _ + "VALUES (" & clientID & ", '" & EscapeSQL(nom) & "', '" & EscapeSQL(description) & "', " & _ + tauxHoraire & ", " & IIf(actif, "True", "False") & ", Now())" + CurrentDb.Execute sql, dbFailOnError + SaveProjet = DMax("ProjetID", "tbl_Projets") + Else + sql = "UPDATE tbl_Projets SET " & _ + "ClientID = " & clientID & ", " & _ + "Nom = '" & EscapeSQL(nom) & "', " & _ + "Description = '" & EscapeSQL(description) & "', " & _ + "TauxHoraire = " & tauxHoraire & ", " & _ + "Actif = " & IIf(actif, "True", "False") & " " & _ + "WHERE ProjetID = " & projetID + CurrentDb.Execute sql, dbFailOnError + SaveProjet = projetID + End If +End Function + +'------------------------------------------------------------------------------- +' Sub: DeleteProjet +' Description: Supprime un projet et ses entrees de temps +'------------------------------------------------------------------------------- +Public Sub DeleteProjet(ByVal projetID As Long) + CurrentDb.Execute "DELETE FROM tbl_Temps WHERE ProjetID = " & projetID + CurrentDb.Execute "DELETE FROM tbl_Projets WHERE ProjetID = " & projetID +End Sub + +'=============================================================================== +' TEMPS +'=============================================================================== + +'------------------------------------------------------------------------------- +' Function: GetTemps +' Description: Retourne les entrees de temps avec filtres +'------------------------------------------------------------------------------- +Public Function GetTemps(Optional ByVal projetID As Long = 0, _ + Optional ByVal clientID As Long = 0, _ + Optional ByVal dateDebut As Date = 0, _ + Optional ByVal dateFin As Date = 0) As DAO.Recordset + Dim sql As String + sql = "SELECT t.*, p.Nom AS ProjetNom, c.Nom AS ClientNom, " & _ + "t.Duree * p.TauxHoraire AS Montant " & _ + "FROM (tbl_Temps t " & _ + "INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID) " & _ + "INNER JOIN tbl_Clients c ON p.ClientID = c.ClientID WHERE 1=1" + + If projetID > 0 Then + sql = sql & " AND t.ProjetID = " & projetID + End If + + If clientID > 0 Then + sql = sql & " AND p.ClientID = " & clientID + End If + + If dateDebut > 0 Then + sql = sql & " AND t.Date >= #" & Format(dateDebut, "yyyy-mm-dd") & "#" + End If + + If dateFin > 0 Then + sql = sql & " AND t.Date <= #" & Format(dateFin, "yyyy-mm-dd") & "#" + End If + + sql = sql & " ORDER BY t.Date DESC" + + Set GetTemps = CurrentDb.OpenRecordset(sql, dbOpenDynaset) +End Function + +'------------------------------------------------------------------------------- +' Function: SaveTemps +' Description: Sauvegarde une entree de temps +'------------------------------------------------------------------------------- +Public Function SaveTemps(ByVal projetID As Long, _ + ByVal dateEntree As Date, _ + ByVal duree As Double, _ + Optional ByVal description As String = "", _ + Optional ByVal tempsID As Long = 0) As Long + Dim sql As String + + If tempsID = 0 Then + sql = "INSERT INTO tbl_Temps (ProjetID, Date, Duree, Description, DateCreation) " & _ + "VALUES (" & projetID & ", #" & Format(dateEntree, "yyyy-mm-dd") & "#, " & _ + duree & ", '" & EscapeSQL(description) & "', Now())" + CurrentDb.Execute sql, dbFailOnError + SaveTemps = DMax("TempsID", "tbl_Temps") + Else + sql = "UPDATE tbl_Temps SET " & _ + "ProjetID = " & projetID & ", " & _ + "Date = #" & Format(dateEntree, "yyyy-mm-dd") & "#, " & _ + "Duree = " & duree & ", " & _ + "Description = '" & EscapeSQL(description) & "' " & _ + "WHERE TempsID = " & tempsID + CurrentDb.Execute sql, dbFailOnError + SaveTemps = tempsID + End If +End Function + +'------------------------------------------------------------------------------- +' Sub: DeleteTemps +' Description: Supprime une entree de temps +'------------------------------------------------------------------------------- +Public Sub DeleteTemps(ByVal tempsID As Long) + CurrentDb.Execute "DELETE FROM tbl_Temps WHERE TempsID = " & tempsID +End Sub + +'=============================================================================== +' HELPERS +'=============================================================================== + +'------------------------------------------------------------------------------- +' Function: EscapeSQL +' Description: Echappe les apostrophes pour SQL +'------------------------------------------------------------------------------- +Private Function EscapeSQL(ByVal text As String) As String + EscapeSQL = Replace(text, "'", "''") +End Function diff --git a/src/mod_Export.bas b/src/mod_Export.bas new file mode 100644 index 0000000..736779b --- /dev/null +++ b/src/mod_Export.bas @@ -0,0 +1,102 @@ +Attribute VB_Name = "mod_Export" +Option Compare Database +Option Explicit + +'=============================================================================== +' Module: mod_Export +' Description: Fonctions d'export PDF et Excel +' Auteur: Alexis Trouve +' Date: 2025-12-30 +'=============================================================================== + +'------------------------------------------------------------------------------- +' Sub: ExportReportPDF +' Description: Exporte un rapport en PDF +'------------------------------------------------------------------------------- +Public Sub ExportReportPDF(ByVal reportName As String, _ + Optional ByVal fileName As String = "") + Dim filePath As String + + mod_Config.EnsureFoldersExist + + If fileName = "" Then + fileName = reportName & "_" & Format(Now, "yyyymmdd_hhnnss") & ".pdf" + End If + + filePath = EXPORT_PATH & fileName + + DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, filePath + + MsgBox "Rapport exporte vers:" & vbCrLf & filePath, vbInformation + + ' Ouvrir le fichier + Shell "explorer """ & filePath & """", vbNormalFocus +End Sub + +'------------------------------------------------------------------------------- +' Sub: ExportQueryExcel +' Description: Exporte une requete vers Excel +'------------------------------------------------------------------------------- +Public Sub ExportQueryExcel(ByVal queryName As String, _ + Optional ByVal fileName As String = "") + Dim filePath As String + + mod_Config.EnsureFoldersExist + + If fileName = "" Then + fileName = queryName & "_" & Format(Now, "yyyymmdd_hhnnss") & ".xlsx" + End If + + filePath = EXPORT_PATH & fileName + + DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _ + queryName, filePath, True + + MsgBox "Donnees exportees vers:" & vbCrLf & filePath, vbInformation + + ' Ouvrir le fichier + Shell "explorer """ & filePath & """", vbNormalFocus +End Sub + +'------------------------------------------------------------------------------- +' Sub: ExportTempsPeriodeExcel +' Description: Exporte les temps d'une periode vers Excel +'------------------------------------------------------------------------------- +Public Sub ExportTempsPeriodeExcel(ByVal dateDebut As Date, _ + ByVal dateFin As Date, _ + Optional ByVal clientID As Long = 0) + Dim sql As String + Dim qdf As DAO.QueryDef + Dim fileName As String + + ' Creer requete temporaire + sql = "SELECT t.Date, c.Nom AS Client, p.Nom AS Projet, " & _ + "t.Duree, t.Description, t.Duree * p.TauxHoraire AS Montant " & _ + "FROM (tbl_Temps t " & _ + "INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID) " & _ + "INNER JOIN tbl_Clients c ON p.ClientID = c.ClientID " & _ + "WHERE t.Date BETWEEN #" & Format(dateDebut, "yyyy-mm-dd") & "# " & _ + "AND #" & Format(dateFin, "yyyy-mm-dd") & "#" + + If clientID > 0 Then + sql = sql & " AND p.ClientID = " & clientID + End If + + sql = sql & " ORDER BY t.Date" + + ' Supprimer si existe + On Error Resume Next + CurrentDb.QueryDefs.Delete "qry_TempExport" + On Error GoTo 0 + + Set qdf = CurrentDb.CreateQueryDef("qry_TempExport", sql) + + ' Exporter + fileName = "Temps_" & Format(dateDebut, "yyyymmdd") & "_" & _ + Format(dateFin, "yyyymmdd") & ".xlsx" + + ExportQueryExcel "qry_TempExport", fileName + + ' Nettoyer + CurrentDb.QueryDefs.Delete "qry_TempExport" +End Sub diff --git a/src/mod_FormBuilder.bas b/src/mod_FormBuilder.bas new file mode 100644 index 0000000..fcacc48 --- /dev/null +++ b/src/mod_FormBuilder.bas @@ -0,0 +1,212 @@ +Attribute VB_Name = "mod_FormBuilder" +Option Compare Database +Option Explicit + +'=============================================================================== +' Module: mod_FormBuilder +' Description: Creation programmatique des formulaires +' Auteur: Alexis Trouve +' Date: 2025-12-30 +'=============================================================================== + +Private Const acLabel As Integer = 100 +Private Const acTextBox As Integer = 109 +Private Const acComboBox As Integer = 111 +Private Const acCommandButton As Integer = 104 +Private Const acDetail As Integer = 0 +Private Const acHeader As Integer = 1 + +Public Sub BuildAllForms() + On Error GoTo ErrHandler + BuildFormAccueil + BuildFormClients + BuildFormProjets + BuildFormSaisieTemps + BuildFormHistorique + MsgBox "Formulaires crees avec succes!", vbInformation + Exit Sub +ErrHandler: + MsgBox "Erreur: " & Err.Description, vbCritical +End Sub + +Public Sub BuildFormAccueil() + On Error GoTo ErrHandler + Dim frm As Form, ctl As Control + On Error Resume Next + DoCmd.DeleteObject acForm, "frm_Accueil" + On Error GoTo ErrHandler + Set frm = CreateForm() + frm.Caption = "TimeTrack Pro" + frm.RecordSelectors = False + frm.NavigationButtons = False + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 500, 300, 5000, 500) + ctl.Caption = "TimeTrack Pro" + ctl.FontSize = 20 + ctl.FontBold = True + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 1200, 2200, 500) + ctl.Caption = "Clients" + ctl.OnClick = "=OpenFormClients()" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 1900, 2200, 500) + ctl.Caption = "Projets" + ctl.OnClick = "=OpenFormProjets()" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 2600, 2200, 500) + ctl.Caption = "Saisie Temps" + ctl.OnClick = "=OpenFormSaisieTemps()" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 3300, 2200, 500) + ctl.Caption = "Historique" + ctl.OnClick = "=OpenFormHistorique()" + DoCmd.Close acForm, frm.Name, acSaveYes + DoCmd.Rename "frm_Accueil", acForm, frm.Name + Exit Sub +ErrHandler: + MsgBox "Erreur Accueil: " & Err.Description, vbCritical +End Sub + +Public Sub BuildFormClients() + On Error GoTo ErrHandler + Dim frm As Form, ctl As Control + On Error Resume Next + DoCmd.DeleteObject acForm, "frm_Clients" + On Error GoTo ErrHandler + Set frm = CreateForm() + frm.RecordSource = "tbl_Clients" + frm.Caption = "Clients" + frm.NavigationButtons = True + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250) + ctl.Caption = "Nom:" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 200, 3500, 250) + ctl.ControlSource = "Nom" + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250) + ctl.Caption = "Email:" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 3500, 250) + ctl.ControlSource = "Email" + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250) + ctl.Caption = "Tel:" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 2000, 250) + ctl.ControlSource = "Telephone" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 1400, 1500, 400) + ctl.Caption = "Nouveau" + ctl.OnClick = "=GoToNewRecord()" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 1400, 1500, 400) + ctl.Caption = "Retour" + ctl.OnClick = "=OpenFormAccueil()" + DoCmd.Close acForm, frm.Name, acSaveYes + DoCmd.Rename "frm_Clients", acForm, frm.Name + Exit Sub +ErrHandler: + MsgBox "Erreur Clients: " & Err.Description, vbCritical +End Sub + +Public Sub BuildFormProjets() + On Error GoTo ErrHandler + Dim frm As Form, ctl As Control + On Error Resume Next + DoCmd.DeleteObject acForm, "frm_Projets" + On Error GoTo ErrHandler + Set frm = CreateForm() + frm.RecordSource = "tbl_Projets" + frm.Caption = "Projets" + frm.NavigationButtons = True + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250) + ctl.Caption = "Client:" + Set ctl = CreateControl(frm.Name, acComboBox, acDetail, , , 1500, 200, 3000, 250) + ctl.ControlSource = "ClientID" + ctl.RowSource = "SELECT ClientID, Nom FROM tbl_Clients" + ctl.ColumnCount = 2 + ctl.ColumnWidths = "0;2500" + ctl.BoundColumn = 1 + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250) + ctl.Caption = "Nom:" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 3000, 250) + ctl.ControlSource = "Nom" + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250) + ctl.Caption = "Taux:" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 1500, 250) + ctl.ControlSource = "TauxHoraire" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 1400, 1500, 400) + ctl.Caption = "Nouveau" + ctl.OnClick = "=GoToNewRecord()" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 1400, 1500, 400) + ctl.Caption = "Retour" + ctl.OnClick = "=OpenFormAccueil()" + DoCmd.Close acForm, frm.Name, acSaveYes + DoCmd.Rename "frm_Projets", acForm, frm.Name + Exit Sub +ErrHandler: + MsgBox "Erreur Projets: " & Err.Description, vbCritical +End Sub + +Public Sub BuildFormSaisieTemps() + On Error GoTo ErrHandler + Dim frm As Form, ctl As Control + On Error Resume Next + DoCmd.DeleteObject acForm, "frm_SaisieTemps" + On Error GoTo ErrHandler + Set frm = CreateForm() + frm.RecordSource = "tbl_Temps" + frm.Caption = "Saisie Temps" + frm.NavigationButtons = True + frm.DataEntry = True + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250) + ctl.Caption = "Projet:" + Set ctl = CreateControl(frm.Name, acComboBox, acDetail, , , 1500, 200, 4000, 250) + ctl.ControlSource = "ProjetID" + ctl.RowSource = "SELECT ProjetID, Nom FROM tbl_Projets WHERE Actif=True" + ctl.ColumnCount = 2 + ctl.ColumnWidths = "0;3500" + ctl.BoundColumn = 1 + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250) + ctl.Caption = "Date:" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 1800, 250) + ctl.ControlSource = "Date" + ctl.DefaultValue = "=Date()" + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250) + ctl.Caption = "Duree:" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 1000, 250) + ctl.ControlSource = "Duree" + Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 1250, 1200, 250) + ctl.Caption = "Notes:" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 1250, 4000, 600) + ctl.ControlSource = "Description" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 2000, 1500, 400) + ctl.Caption = "Enregistrer" + ctl.OnClick = "=SaveAndNew()" + Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 2000, 1500, 400) + ctl.Caption = "Retour" + ctl.OnClick = "=OpenFormAccueil()" + DoCmd.Close acForm, frm.Name, acSaveYes + DoCmd.Rename "frm_SaisieTemps", acForm, frm.Name + Exit Sub +ErrHandler: + MsgBox "Erreur Saisie: " & Err.Description, vbCritical +End Sub + +Public Sub BuildFormHistorique() + On Error GoTo ErrHandler + Dim frm As Form, ctl As Control + On Error Resume Next + DoCmd.DeleteObject acForm, "frm_Historique" + On Error GoTo ErrHandler + Set frm = CreateForm() + frm.RecordSource = "SELECT t.*, p.Nom AS Projet, c.Nom AS Client FROM (tbl_Temps t INNER JOIN tbl_Projets p ON t.ProjetID=p.ProjetID) INNER JOIN tbl_Clients c ON p.ClientID=c.ClientID" + frm.Caption = "Historique" + frm.DefaultView = 2 + frm.AllowEdits = False + frm.AllowAdditions = False + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 100, 100, 1500, 250) + ctl.ControlSource = "Client" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1700, 100, 1500, 250) + ctl.ControlSource = "Projet" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 3300, 100, 1200, 250) + ctl.ControlSource = "Date" + Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 4600, 100, 800, 250) + ctl.ControlSource = "Duree" + Set ctl = CreateControl(frm.Name, acCommandButton, acHeader, , , 200, 200, 1500, 400) + ctl.Caption = "Retour" + ctl.OnClick = "=OpenFormAccueil()" + DoCmd.Close acForm, frm.Name, acSaveYes + DoCmd.Rename "frm_Historique", acForm, frm.Name + Exit Sub +ErrHandler: + MsgBox "Erreur Historique: " & Err.Description, vbCritical +End Sub diff --git a/src/mod_Navigation.bas b/src/mod_Navigation.bas new file mode 100644 index 0000000..0fde99b --- /dev/null +++ b/src/mod_Navigation.bas @@ -0,0 +1,104 @@ +Attribute VB_Name = "mod_Navigation" +Option Compare Database +Option Explicit + +'=============================================================================== +' Module: mod_Navigation +' Description: Fonctions de navigation entre formulaires +' Auteur: Alexis Trouve +' Date: 2025-12-30 +'=============================================================================== + +Public Sub OpenFormAccueil() + DoCmd.OpenForm "frm_Accueil" +End Sub + +Public Sub OpenFormClients(Optional ByVal clientID As Long = 0) + DoCmd.OpenForm "frm_Clients" + If clientID > 0 Then + Forms!frm_Clients.Recordset.FindFirst "ClientID = " & clientID + End If +End Sub + +Public Sub OpenFormProjets(Optional ByVal clientID As Long = 0) + Dim strFilter As String + If clientID > 0 Then + strFilter = "ClientID = " & clientID + DoCmd.OpenForm "frm_Projets", , , strFilter + Else + DoCmd.OpenForm "frm_Projets" + End If +End Sub + +Public Sub OpenFormSaisieTemps(Optional ByVal projetID As Long = 0) + DoCmd.OpenForm "frm_SaisieTemps" + If projetID > 0 Then + Forms!frm_SaisieTemps!cboProjet = projetID + End If +End Sub + +Public Sub OpenFormHistorique() + DoCmd.OpenForm "frm_Historique" +End Sub + +Public Sub CloseCurrentForm() + DoCmd.Close acForm, Screen.ActiveForm.Name +End Sub + +Public Sub CloseAllForms() + Dim frm As Form + For Each frm In Forms + DoCmd.Close acForm, frm.Name + Next frm +End Sub + +Public Sub RefreshCurrentForm() + Screen.ActiveForm.Requery +End Sub + +'------------------------------------------------------------------------------- +' Function: GoToNewRecord +' Description: Navigue vers un nouvel enregistrement (pour boutons) +'------------------------------------------------------------------------------- +Public Function GoToNewRecord() As Boolean + On Error GoTo ErrHandler + DoCmd.GoToRecord , , acNewRec + GoToNewRecord = True + Exit Function +ErrHandler: + MsgBox "Erreur: " & Err.Description, vbExclamation, "Nouveau" + GoToNewRecord = False +End Function + +'------------------------------------------------------------------------------- +' Function: DeleteCurrentRecord +' Description: Supprime l'enregistrement courant avec confirmation +'------------------------------------------------------------------------------- +Public Function DeleteCurrentRecord() As Boolean + On Error GoTo ErrHandler + If MsgBox("Voulez-vous supprimer?", vbYesNo + vbQuestion, "Confirmer") = vbYes Then + DoCmd.RunCommand acCmdDeleteRecord + DeleteCurrentRecord = True + Else + DeleteCurrentRecord = False + End If + Exit Function +ErrHandler: + MsgBox "Erreur: " & Err.Description, vbExclamation, "Supprimer" + DeleteCurrentRecord = False +End Function + +'------------------------------------------------------------------------------- +' Function: SaveAndNew +' Description: Sauvegarde l'enregistrement et va vers nouveau +'------------------------------------------------------------------------------- +Public Function SaveAndNew() As Boolean + On Error GoTo ErrHandler + DoCmd.RunCommand acCmdSaveRecord + DoCmd.GoToRecord , , acNewRec + SaveAndNew = True + Exit Function +ErrHandler: + MsgBox "Erreur: " & Err.Description, vbExclamation, "Enregistrer" + SaveAndNew = False +End Function diff --git a/src/mod_Utils.bas b/src/mod_Utils.bas new file mode 100644 index 0000000..b53c2d4 --- /dev/null +++ b/src/mod_Utils.bas @@ -0,0 +1,111 @@ +Attribute VB_Name = "mod_Utils" +Option Compare Database +Option Explicit + +'=============================================================================== +' Module: mod_Utils +' Description: Fonctions utilitaires diverses +' Auteur: Alexis Trouve +' Date: 2025-12-30 +'=============================================================================== + +'------------------------------------------------------------------------------- +' Function: FormatDuree +' Description: Formate une duree en heures +'------------------------------------------------------------------------------- +Public Function FormatDuree(ByVal heures As Double) As String + FormatDuree = Format(heures, "0.00") & " h" +End Function + +'------------------------------------------------------------------------------- +' Function: FormatMontant +' Description: Formate un montant en euros +'------------------------------------------------------------------------------- +Public Function FormatMontant(ByVal montant As Currency) As String + FormatMontant = Format(montant, "#,##0.00") & " EUR" +End Function + +'------------------------------------------------------------------------------- +' Function: FormatDateFR +' Description: Formate une date en francais +'------------------------------------------------------------------------------- +Public Function FormatDateFR(ByVal d As Date) As String + FormatDateFR = Format(d, "dd/mm/yyyy") +End Function + +'------------------------------------------------------------------------------- +' Function: IsValidEmail +' Description: Valide un format email basique +'------------------------------------------------------------------------------- +Public Function IsValidEmail(ByVal email As String) As Boolean + If Len(email) = 0 Then + IsValidEmail = True ' Email optionnel + Exit Function + End If + + IsValidEmail = (InStr(email, "@") > 1) And (InStr(email, ".") > InStr(email, "@") + 1) +End Function + +'------------------------------------------------------------------------------- +' Function: GetFirstDayOfMonth +' Description: Premier jour du mois +'------------------------------------------------------------------------------- +Public Function GetFirstDayOfMonth(Optional ByVal d As Date = 0) As Date + If d = 0 Then d = Date + GetFirstDayOfMonth = DateSerial(Year(d), Month(d), 1) +End Function + +'------------------------------------------------------------------------------- +' Function: GetLastDayOfMonth +' Description: Dernier jour du mois +'------------------------------------------------------------------------------- +Public Function GetLastDayOfMonth(Optional ByVal d As Date = 0) As Date + If d = 0 Then d = Date + GetLastDayOfMonth = DateSerial(Year(d), Month(d) + 1, 0) +End Function + +'------------------------------------------------------------------------------- +' Function: GetFirstDayOfWeek +' Description: Premier jour de la semaine (lundi) +'------------------------------------------------------------------------------- +Public Function GetFirstDayOfWeek(Optional ByVal d As Date = 0) As Date + If d = 0 Then d = Date + GetFirstDayOfWeek = d - Weekday(d, vbMonday) + 1 +End Function + +'------------------------------------------------------------------------------- +' Sub: ShowError +' Description: Affiche un message d'erreur standardise +'------------------------------------------------------------------------------- +Public Sub ShowError(ByVal message As String, Optional ByVal details As String = "") + Dim msg As String + msg = message + If Len(details) > 0 Then + msg = msg & vbCrLf & vbCrLf & "Details: " & details + End If + MsgBox msg, vbExclamation, APP_NAME +End Sub + +'------------------------------------------------------------------------------- +' Sub: ShowInfo +' Description: Affiche un message d'information +'------------------------------------------------------------------------------- +Public Sub ShowInfo(ByVal message As String) + MsgBox message, vbInformation, APP_NAME +End Sub + +'------------------------------------------------------------------------------- +' Function: Confirm +' Description: Demande confirmation a l'utilisateur +'------------------------------------------------------------------------------- +Public Function Confirm(ByVal message As String) As Boolean + Confirm = (MsgBox(message, vbQuestion + vbYesNo, APP_NAME) = vbYes) +End Function + +'------------------------------------------------------------------------------- +' Sub: LogAction +' Description: Log une action (pour debug) +'------------------------------------------------------------------------------- +Public Sub LogAction(ByVal action As String) + Debug.Print Format(Now, "yyyy-mm-dd hh:nn:ss") & " - " & action +End Sub