آموزش اکسس (بخش اول) تعريف كلي از اكسسAccess اكسس ابزاري براي توليد بانكهاي اطلاعاتي رابطه اي است. بانكهاي اطلاعاتي امكان گردآوري انواع اطلاعات را براي ذخيره سازي ،جستجو و بازيابي فراهم ميكند. اجزا بانك اطلاعاتي اكسس عبارتند از: DataBase: 1. Table 2. Query 3. Form 4. Report 5. Macros 6. Modules • Table جدول ) هر جدول براي نگهداري دادههاي خام بانك اطلاعاتي است.دادهها را شما در جدول وارد ميكنيد.جداول سپس اين دادهها را به شكل سطرها و ستونهايي سازماندهي ميكند. • Query :هر پرس و جو براي استخراج اطلاعات مورد نظر از يك بانك اطلاعاتي مورد استفاده قرار ميگيردهر پرس و جو ميتواند گروهي از ركوردها را كه شرايط خاص دارا هستند انتخاب كند.پرس و جوها را ميتوان بر اساس جداول يا پرس و جوهاي ديگر اماده نمود. با استفاده از پزسوجوها ميتوان ركوردهاي بانك اطلاعاتي را انتخاب كرد، تغيير داد و يا حذف نمود. • Form :متداولترين روش استفاده از فرمها،براي ورود و نمايش دادهها است. • Report :گزارش ها ميتوانند بر اساس جدول ،پرسوجوها باشند ،قابليت گزارش چاپ دادهها ميباشدگزارشها را ميتوان بر اساس چند جدول و پرسوجو تهيه نمود تا رابطه بين دادهها را نشان داد. • Macro :ماكروها به خودكار كردن كارهاي تكراري ،بدون نوشتن برنامههاي پيچيده يا فراگيري يك زبان برنامه نويسي ، ياري ميكند، در واقع ماكروها يكسري قابليتهايي هستند كه امكان سريع سازي را فراهم ميسازند. • Modules : محيط بسيار قوي و با كيفيت براي برنامهنويسي محاسبات و عمليات پيچيده روي سيستم بانك اطلاعاتي. ----------------------------------- الف - تعريف دادهData : هرگونه اطلاعات لازم و كاربردي درباره يك موجوديت را يك داده ميگويند. ب- تعريف Fild : به هر ستون يك جدول كه در بر گيرنده كليه اطلاعات مربوط به آن ستون ميباشد و بخشي از يك موجوديت را تشگيل ميدهد فيلد گفته ميشود. ت- تعريف Record : به هر سطر يك جدول كه اطلاعات مربوط به يك موجوديت را نشان ميدهد ، ركورد گويند. ث- تعريف پايگاه دادهاي ارتباطي: پايگاه دادههاي ارتباطي، مجموعهاي از جدولهاي داده است كه يك فيلد مشترك در هر يك از جدولهاي موجود دارد و از طريق آن ميتوان دادهها را بهم ربط داد.به اين مدل از پايگاه دادهها ، پايگاه دادههاي ارتباطي RelationShip ميگويند.
پاسخ : جامع آموزش Access آموزش اکسس (بخش دوم) تابع تبديل عدد به حروف مقدمه : در اين يادداشت تابع مربوط به تبديل عدد به معادل حروفي آن ارائه مي كنم . عمدتا در سيستم هاي مالي و حسابداري نياز است معادل حروفي اعداد هم نمايش داده شده يا چاپ شوند كه توابع زير اين نياز را پاسخ مي دهد. مثلا براي چاپ يك چك روي خود برگه چك ، علاوه بر نياز به چاپ مبلغ عددي چك لازمست تا مبلغ حروفي چك هم روي برگه چاپ شود. نحوه استفاده از تابع : تابع Adad كه در زير ارائه شده است يك عدد را بعنوان ورودي گرفته و معادل حروفي آن عدد در زبان فارسي را بعنوان خروجي توليد مي كند. مثلا (Adad(1373 مقدار"يكهزار و سيصد و هفتاد و سه" را بعنوان خروجي توليد مي كند.براي استفاده از اين توابع بايد از چند خط پايين تر (Start of Module) تا انتهاي اين يادداشت را در حافظه كپي (Copy) كرده و در يك ماجول جديد در اكسس يا VB ، Paste كنيد . ( توجه داشته باشيد كه نمايش كدهاي نوشته شده در اينجا راست به چپ است كه پس از كپي كردن آن در ماجول اكسس بشكل صحيح نمايش داده خواهد شد) ' *********** Start of Module *********** 'توابع تبديل عدد به معادل حروفي آن در زبان فارسي 'برنامه نويس : حميد آزادي اردكاني 'ويرايش اول : ارديبهشت 1380 ' پست الكترونيك : azadi1355@yahoo.com ' آدرس وب : http://try.persianblog.com Function Adad(ByVal Number As Double) As String If Number = 0 Then Adad = "صفر" End If Dim Flag As Boolean Dim S As String Dim I, L As Byte Dim K(1 To 5) As Double S = Trim(Str(Number)) L = Len(S) If L > 15 Then Adad = "بسيار بزرگ" Exit Function End If For I = 1 To 15 - L S = "0" & S Next I For I = 1 To Int((L / 3) + 0.99) K(5 - I + 1) = Val(Mid(S, 3 * (5 - I) + 1, 3)) Next I Flag = False S = "" For I = 1 To 5 If K(I) <> 0 Then Select Case I Case 1 S = S & Three(K(I)) & " تريليون" Flag = True Case 2 S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " ميليارد" Flag = True Case 3 S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " ميليون" Flag = True Case 4 S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " هزار" Flag = True Case 5 S = S & IIf(Flag = True, " و ", "") & Three(K(I)) End Select End If Next I Adad = S End Function Function Three(ByVal Number As Integer) As String Dim S As String Dim I, L As Long Dim h(1 To 3) As Byte Dim Flag As Boolean L = Len(Trim(Str(Number))) If Number = 0 Then Three = "" Exit Function End If If Number = 100 Then Three = "يكصد" Exit Function End If If L = 2 Then h(1) = 0 If L = 1 Then h(1) = 0 h(2) = 0 End If For I = 1 To L h(3 - I + 1) = Mid(Trim(Str(Number)), L - I + 1, 1) Next I Select Case h(1) Case 1 S = "يكصد" Case 2 S = "دويست" Case 3 S = "سيصد" Case 4 S = "چهارصد" Case 5 S = "پانصد" Case 6 S = "ششصد" Case 7 S = "هفتصد" Case 8 S = "هشتصد" Case 9 S = "نهصد" End Select Select Case h(2) Case 1 Select Case h(3) Case 0 S = S & " و " & "ده" Case 1 S = S & " و " & "يازده" Case 2 S = S & " و " & "دوازده" Case 3 S = S & " و " & "سيزده" Case 4 S = S & " و " & "چهارده" Case 5 S = S & " و " & "پانزده" Case 6 S = S & " و " & "شانزده" Case 7 S = S & " و " & "هفده" Case 8 S = S & " و " & "هجده" Case 9 S = S & " و " & "نوزده" End Select Case 2 S = S & " و " & "بيست" Case 3 S = S & " و " & "سي" Case 4 S = S & " و " & "چهل" Case 5 S = S & " و " & "پنجاه" Case 6 S = S & " و " & "شصت" Case 7 S = S & " و " & "هفتاد" Case 8 S = S & " و " & "هشتاد" Case 9 S = S & " و " & "نود" End Select If h(2) <> 1 Then Select Case h(3) Case 1 S = S & " و " & "يك" Case 2 S = S & " و " & "دو" Case 3 S = S & " و " & "سه" Case 4 S = S & " و " & "چهار" Case 5 S = S & " و " & "پنج" Case 6 S = S & " و " & "شش" Case 7 S = S & " و " & "هفت" Case 8 S = S & " و " & "هشت" Case 9 S = S & " و " & "نه" End Select End If S = IIf(L < 3, Right(S, Len(S) - 3), S) Three = S End Function
پاسخ : جامع آموزش Access n آموزش اکسس (بخش سوم) در اين يادداشت روش غيرفعال كردن دكمه Shift به هنگام باز شدن فايلهاي اكسس را توضيح خواهم داد . در ابتدا بايد مقدمه اي را عنوان كنم. مقدمه مطلب زير در زمينه افزايش امنيت سيستم ها است. نكته اي كه در زمينه امنيت هر نوع سيستمي بايد به آن توجه داشت اينست كه بطور كلي امنيت يك امر نسبي است . بعبارت ديگر يك راه حل امنيتي ، قطعا جلوي بسياري از حملات عليه سيستم را خواهد گرفت ولي هيچگاه بطور كامل حملات را خنثي نخواهد كرد و هميشه حفره هاي امنيتي وجود خواهند داشت . در يادداشت قبل گفتيم كه به هنگام باز شدن فايلهاي اكسس، Startup اجراء مي شود . به كمك گزينه هاي Startup مي توانيم از دسترسي كاربران به محيط طراحي برنامه جلوگيري كنيم . ولي همانطور كه قبلا گفته شد ميكرو سافت با انگيزه ايجاد سيستم امنيتي چند مرحله اي يك روش ضد امنيتي براي آن ايجاد كرده است و كاربران برنامه ما مي توانند با پايين نگه داشتن دكمه Shift از اجراء Startup جلوگيري كنند و وارد محيط طراحي شوند . حال اگر بخواهيم دكمه شيفت را غير فعال كنيم تا كسي نتواند وارد محيط طراحي شود بايد به اين طريق عمل كرد : استفاده از خاصيت AllowByPassKey خاصيت AllowByPassKey يكي از خواص شيء Database است كه: اگر مقدار آن True باشد دكمه شيفت فعال است . و اگر مقدار آن False باشد دكمه شيفت غير فعال است . اين خاصيت عملا در ليست خواص يك Database نيست و بايد آنرا فقط براي اولين بار ايجاد (Create) كرد . بعد از ايجاد آن مي توان مقدار آنرا False يا True كرد . تذكر : حتما يك كپي از فايل خودتان قبل از اجراء اين برنامه برداريد چون ممكن است ديگر نتوانيد وارد محيط برنامه خودتان شويد . من هم با عرض معذرت وقت پاسخگويي به ايميل هاي دوستان را ندارم و دچار مشكل خواهيد شد. سه دكمه روي يك فرم مطابق شكل بالا ايجاد كنيد و كدهاي زير را در آن بنويسد. (نمايش كدهاي نوشته شده مناسب نيست ولي اگر آنرا در حافظه كپي كنيد و در ماجول فرمتان كپي كند بدرستي تمايش داده مي شود .) 'براي اولين دفعه : Private Sub Create_Click() On Error GoTo Er Dim db As Database Dim prp As Property Set db = CurrentDb Set prp = db.CreateProperty("allowbypasskey", dbBoolean, False) db.Properties.Append prp db.Close Ex: Exit Sub Er: If Err.Number = 3367 Then MsgBox "اين خاصيت ايجاد شده و لازم نيست مجددا ايجاد شود" End If Resume Ex End Sub 'جهت غير فعال كردن شيفت Private Sub ShiftNo_Click() Dim db As Database Set db = CurrentDb db.Properties("allowbypasskey") = False db.Close End Sub 'جهت فعال كردن شيفت Private Sub ShiftOk_Click() Dim db As Database Set db = CurrentDb db.Properties("allowbypasskey") = True db.Close End Sub
پاسخ : جامع آموزش Access آموزش اکسس (بخش چهارم) صدور پيغامهاي فارسي بجاي پيغامهاي Error اكسس يكي از دوستان وبلاگي من پرسيده بود چطوري پيغام Error مربوط به ورود ركورد تكراري را در اكسس فارسي كنيم . ترجيح دادم جواب كاملي براي سئوال ايشون بدم تا همه استفاده كنن. بنابراين ابتدا جواب ايشون رو ميدم و بعد از اون بطور كاملتر براي همه وبلاگي هاي عزيز روش كنترل خطا را تشريح مي كنم . (توجه داشته باشيد كه در زير كدهاي نوشته شده از راست به چپ نمايش داده مي شوند) جواب دوست ما: در رويداد OnError مربوط به فرم ورود اطلاعات اين كد را مي نويسيم: If DataErr = 3022 Then MsgBox "اطلاعات وارده تكراري است" Response = acDataErrContinue End If جواب كلي : اساسا ، هر خطا در اكسس يا VB يك كد توليد مي كند . برنامه نويسان بايد يك بانك اطلاعات از كد خطاهايي كه رخ مي دهد داشته باشند تا بتوانند با چك كردن شماره خطا پيغام فارسي مناسب آن خطا را صادر كنند . بطور كلي دو روش كنترل خطا از اين قرارند: 1- اگر خطا مربوط به كل فرم باشد بايد از طريق رويداد OnError فرم كنترل شود . معمولا خطاهايي كه مربوط به كدنويسي ما نبوده و صرفا توسط اكسس و در واكنش به اشتباهات كاربر صادر مي شود در اين رويداد كنترل مي شود . در اين رويداد ، پارامتر DataErr حاوي كد خطاست. (بعبارت واضح تر اگر مي خواهيد كد مربوط به هر Error را شناسايي كنيد مي توانيد اين دستور در رويداد OnError فرم بنويسيد: MsgBox DataErr ) بطور كلي بعد از اينكه كد خطاها را شناسايي كرديد با نوشتن قالب برنامه زير در رويداد OnError فرم مي توانيد خطاها را كنترل كنيد : Dim Str as String Select Case DataErr Case 3022 Str="اطلاعات وارده تكراري است" Case 2237 Str = "اطلاعات وارده در ليست وجود ندارد" 'خط فوق براي مواردي است كه يك مقداري كه در كمبو باكس وجود ندارد ، تايپ شده باشد Case ... Str=... .... End Select Msgbox Str Response = acDataErrContinue 2- اگر خطا مربوط به كدهايي باشد كه خودمان در يك Sub نوشته ايم : در اين روش بايد در ابتداي Sub با دستور : <اسم زير روال كنترل خطا> On Error Goto ، كنترل خطا را به يك روال كنترل خطا ارجاع دهيم. ( تمام كدهايي كه ويزارد Command Button بطور خودكار در رويداد OnClick دكمه ها ايجاد مي كند نمونه خوبي براي اين روش هستند. ضمنا در اين روش بكمك Err.Number كد خطا شناسايي مي شود )
پاسخ : جامع آموزش Access آموزش اکسس (بخش پنجم) ماجول تاريخ هجري شمسي با توابع جانبي آن در بانك اطلاعاتي Access فيلدهاي نوع Date پاسخگوي نياز كاربران فارسي كه با تاريخ هجري شمسي كار مي كنند نيست . البته برنامه هايي مثل پارسا ۹۹ تقويم سيستم را به تقويم هجري شمسي تبديل مي كند و بعد از آن كاربران فارسي مي توانند از فيلدهاي نوع Date اكسس استفاده كنند .بدين ترتيب پارسا مشكل تاريخ هجري شمسي را حل ميكند ولي بعضا تاريخ شمسي سيستم بنا به دلايلي از بين ميرود . مثلا اگربعد از نصب پارسا، Officeنصب شود تاريخ هجري شمسي سيستم به هم مي خورد. براي رهايي از وابستگي برنامه هاي شما به پارسا و ... ، توابع زير مي تواند مشكل شما را بطور كامل حل كند . اين ماجول در چندين برنامه تست شده و جواب گرفته است شما هم مي توانيد از آن استفاده كنيد. (توجه داشته باشيد كه كدهاي نوشته شده ، در اينجا از چپ به راست نمايش داده شده اند ولي با كپي آن در اكسس ، نمايش آن از چپ به راست خواهد شد) در صورت استفاده از اين ماجول ، فيلدهاي از نوع تاريخ را بايد از نوع Number تعريف كنيد. توضيحات بيشتر جهت استفاده از ماجول ، درون خود ماجول نوشته شده است. براي استفاده از اين ماجول ، از دو خط پايين تر تا انتهاي متن را در حافظه كپي كرده (Copy) و سپس در يك ماجول جديد در اكسس يا VB قرار دهيد (Paste): ' ************************************************************* ' برنامه نويس : حميد آزادي ' Email: azadi1355@yahoo.com ' Web Address: http://try.persianblog.com ' ************************************************************* ' 1- تعريف كنيد Number(Long) است را بصورت Date فيلدهايي كه نوع آنها ' 2- اين فيلدها را بصورت 00/00/00 تنظيم كنيد InputMask خاصيت ' بدليل 6 رقمي در نظر گرفتن فيلد تاريخ ، اين توابع تا سال 1399 كارايي دارد ' ... ' تاريخ جاري سيستم را به هجري شمسي تبديل مي كند Shamsi() تابع ' بكار ببريد Now() را مي توانيد در گزارشات بجاي تابع Dat() تابع ' :براي جلوگيري از ورود تاريخ غلط به درون يك فيلد بترتيب زير عمل ميكنيد ' :بشكل زير بكار ببريد ValidationRule را در خاصيت ValidDate() تابع ' ValidDate([نام فيلد])=True ' ... '******************************************* Public Function Rooz(F_Date As Long) As Byte 'اين تابع عدد مربوط به روز يك تاريخ را برمگرداند Rooz = F_Date Mod 100 End Function '******************************************* Function Mah(F_Date As Long) As Byte 'اين تابع عدد مربوط به ماه يك تاريخ را برمگرداند Mah = Int((F_Date Mod 10000) / 100) End Function '******************************************* Public Function Sal(F_Date As Long) As Byte 'اين تابع عدد مربوط به سال يك تاريخ را برمگرداند Sal = Int(F_Date / 10000) End Function '******************************************* Public Function Kabiseh(ByVal OnlySal As Variant) As Byte 'ورودي تابع عدد دورقمي است 'اين تابع كبيسه بودن سال را برميگرداند 'اگر سال كبيسه باشد عدد يك و درغير اينصورت صفر را بر ميگرداند Kabiseh = 0 If OnlySal >= 75 Then If (OnlySal - 75) Mod 4 = 0 Then Kabiseh = 1 Exit Function End If ElseIf OnlySal <= 70 Then If (70 - OnlySal) Mod 4 = 0 Then Kabiseh = 1 Exit Function End If End If End Function '******************************************* Function ValidDate(F_Date As Long) As Boolean Dim M, S, R As Byte ' اين تابع اعتبار يك عدد ورودي را از نظر تاريخ هجري شمسي بررسي مي كند ' را برمي گرداند False واگر نامعتبر باشد True اگر تاريخ معتبر باشد ValidDate = True S = Sal(F_Date) M = Mah(F_Date) R = Rooz(F_Date) '******** If F_Date < 100101 Then ValidDate = False Exit Function End If If M > 12 Or M = 0 Or R = 0 Then ValidDate = False Exit Function End If If R > MahDays(S, M) Then ValidDate = False Exit Function End If End Function '******************************************* Public Function AddDay(ByVal F_Date As Long, ByVal add As Integer) As Long Dim K, M, S, R, Days As Byte R = Rooz(F_Date) M = Mah(F_Date) S = Sal(F_Date) K = Kabiseh(S) 'تبديل روز به عدد 1 جهت ادامه محاسبات و يا اتمام محاسبه Days = MahDays(S, M) If add > Days - R Then add = add - (Days - R + 1) R = 1 If M < 12 Then M = M + 1 Else M = 1 S = S + 1 End If Else R = R + add add = 0 End If While add > 0 K = Kabiseh(S) 'كبيسه: 1 و غير كبيسه: 0 Days = MahDays(S, M) 'تعداد روزهاي ماه فعلي Select Case add Case Is < Days 'اگر تعداد روزهاي افزودني كمتر از يك ماه باشد R = R + add add = 0 Case Days To IIf(K = 0, 365, 366) - 1 'اگر تعداد روزهاي افزودني بيشتر از يك ماه و كمتر از يك سال باشد add = add - Days If M < 12 Then M = M + 1 Else S = S + 1 M = 1 End If Case Else 'اگر تعداد روزهاي افزودني بيشتر از يك سال باشد S = S + 1 add = add - IIf(K = 0, 365, 366) End Select Wend AddDay = (S * 10000) + (M * 100) + ® End Function '*********************************************** Public Function Shamsi() As Long 'تاريخ جاري سيستم را به تاريخ هجري شمسي تبديل مي كند Dim Shamsi_Mabna As Long Dim Miladi_mabna As Date Dim Dif As Long 'در اينجا 80/10/11 با 2002/01/01 معادل قرارداده شده Shamsi_Mabna = 791012 Miladi_mabna = #1/1/01# Dif = DateDiff("d", Miladi_mabna, Date) If Dif < 0 Then MsgBox "تاريخ جاري سيستم شما نادرست است , آنرا اصلاح كنيد." Else Shamsi = AddDay(Shamsi_Mabna, Dif) End If End Function '*********************************************** Public Function DayWeek(F_Date As Long) As String Dim a As String Dim N As Byte N = DayWeekNo(F_Date) Select Case N Case 0 a = "شنبه" Case 1 a = "يكشنبه" Case 2 a = "دوشنبه" Case 3 a = "سهشنبه" Case 4 a = "چهارشنبه" Case 5 a = "پنجشنبه" Case 6 a = "جمعه" End Select DayWeek = a End Function '*********************************************** Public Function Dat() Dim D As Long D = Shamsi Dat = DayWeek(D) & " 13" & Sal(D) & "/" & Mah(D) & "/" & Rooz(D) End Function '*********************************************** Public Function Diff(ByVal FromDate As Long, ByVal To_Date As Long) As Long 'اين تابع تعداد روزهاي بين دو تاريخ را ارائه مي كند Dim Tmp As Long Dim S1, M1, r1, S2, m2, r2 As Integer Dim Sumation As Single Dim Flag As Boolean Flag = False If FromDate = 0 Or IsNull(FromDate) = True Or To_Date = 0 Or IsNull(To_Date) = True Then Diff = 0 Exit Function End If If FromDate > To_Date Then 'اگر تاريخ شروع از تاريخ پايان بزرگتر باشد آنها موقتا جابجا مي شوند Flag = True Tmp = FromDate FromDate = To_Date To_Date = Tmp End If r1 = Rooz(FromDate) M1 = Mah(FromDate) S1 = Sal(FromDate) r2 = Rooz(To_Date) m2 = Mah(To_Date) S2 = Sal(To_Date) Sumation = 0 Do While S1 < S2 - 1 Or (S1 = S2 - 1 And (M1 < m2 Or (M1 = m2 And r1 <= r2))) 'اگر يك سال يا بيشتر اختلاف بود If Kabiseh((S1)) = 1 Then If M1 = 12 And r1 = 30 Then Sumation = Sumation + 365 r1 = 29 Else Sumation = Sumation + 366 End If Else Sumation = Sumation + 365 End If S1 = S1 + 1 Loop Do While S1 < S2 Or M1 < m2 - 1 Or (M1 = m2 - 1 And r1 < r2) 'اگر يك ماه يا بيشتر اختلاف بود Select Case M1 Case 1 To 6 If M1 = 6 And r1 = 31 Then Sumation = Sumation + 30 r1 = 30 Else Sumation = Sumation + 31 End If M1 = M1 + 1 Case 7 To 11 If M1 = 11 And r1 = 30 And Kabiseh(S1) = 0 Then Sumation = Sumation + 29 r1 = 29 Else Sumation = Sumation + 30 End If M1 = M1 + 1 Case 12 If Kabiseh(S1) = 1 Then Sumation = Sumation + 30 Else Sumation = Sumation + 29 End If S1 = S1 + 1 M1 = 1 End Select Loop If M1 = m2 Then Sumation = Sumation + (r2 - r1) Else Select Case M1 Case 1 To 6 Sumation = Sumation + (31 - r1) + r2 Case 7 To 11 Sumation = Sumation + (30 - r1) + r2 Case 12 If Kabiseh(S1) = 1 Then Sumation = Sumation + (30 - r1) + r2 Else Sumation = Sumation + (29 - r1) + r2 End If End Select End If If Flag = True Then Sumation = -Sumation End If Diff = Sumation End Function Public Function DayWeekNo(F_Date As Long) As String 'اين تابع يك تاريخ را دريافت كرده و مشخص مي كند چه روزي از هفته است 'اگر شنبه باشد عدد 0 'اگر 1شنبه باشد عدد 1 '...... 'اگر جمعه باشد عدد 6 Dim day As String Dim Shmsi_Mabna As Long Dim Dif As Long 'مبنا 80/10/11 Shmsi_Mabna = 801011 Dif = Diff(Shmsi_Mabna, F_Date) If Shmsi_Mabna > F_Date Then Dif = -Dif End If 'با توجه به اينكه 80/10/11 3شنبه است محاسبه ميشود day متغير day = (Dif + 3) Mod 7 If day < 0 Then DayWeekNo = day + 7 Else DayWeekNo = day End If End Function Function MahName(ByVal Mah_no As Byte) As String Select Case Mah_no Case 1 MahName = "فروردين" Case 2 MahName = "ارديبهشت" Case 3 MahName = "خرداد" Case 4 MahName = "تير" Case 5 MahName = "مرداد" Case 6 MahName = "شهريور" Case 7 MahName = "مهر" Case 8 MahName = "آبان" Case 9 MahName = "آذر" Case 10 MahName = "دي" Case 11 MahName = "بهمن" Case 12 MahName = "اسفند" End Select End Function Function SalMah(ByVal F_Date As Long) As Integer 'چهار رقم اول تاريخ كه معرف سال و ماه است را برمي گرداند SalMah = Val(Left$(F_Date, 4)) End Function Function MahDays(ByVal Sal As Byte, ByVal Mah As Byte) As Byte 'اين تابع تعداد روزهاي يك ماه را برمي گرداند Select Case Mah Case 1 To 6 MahDays = 31 Case 7 To 11 MahDays = 30 Case 12 If Kabiseh(Sal) = 1 Then MahDays = 30 Else MahDays = 29 End If End Select End Function Function Make_Date(ByVal F_Date As Long) As String 'يك تاريخ را بصورت يك رشته 10 رقمي با ذكر چهار رقم براي سال ارائه مي كند Dim D As String D = Trim(Str(F_Date)) If IsNull(F_Date) = True Or F_Date = 0 Then Make_Date = "" Else Make_Date = "13" & Mid(D, 1, 2) & "/" & Mid(D, 3, 2) & "/" & Mid(D, 5, 2) End If End Function Function NextMah(ByVal Sal_Mah As Integer) As Integer If (Sal_Mah Mod 100) = 12 Then NextMah = (Int(Sal_Mah / 100) + 1) * 100 + 1 Else NextMah = Sal_Mah + 1 End If End Function Function PreviousMah(ByVal Sal_Mah As Integer) As Integer If (Sal_Mah Mod 100) = 1 Then PreviousMah = (Int(Sal_Mah / 100) - 1) * 100 + 12 Else PreviousMah = Sal_Mah - 1 End If End Function Function SubtractDay(ByVal F_Date As Long, ByVal Subtract As Long) As Long 'به تعداد روز معيني از يك تاريخ كم كرده و تاريخ حاصله را ارائه ميكند Dim K, M, S, R, Days As Byte R = Rooz(F_Date) M = Mah(F_Date) S = Sal(F_Date) K = Kabiseh(S) 'تبديل روز به عدد 1 جهت ادامه محاسبات و يا اتمام محاسبه If Subtract >= R - 1 Then Subtract = Subtract - (R - 1) R = 1 Else R = R - Subtract Subtract = 0 End If While Subtract > 0 K = Kabiseh(S - 1) 'كبيسه: 1 و غير كبيسه: 0 Days = MahDays(IIf(M >= 2, S, S - 1), IIf(M >= 2, M - 1, 12)) 'تعداد روزهاي ماه قبلي Select Case Subtract Case Is < Days 'اگر تعداد روزهاي كاهش كمتر از يك ماه باشد R = Days - Subtract + 1 Subtract = 0 If M >= 2 Then M = M - 1 Else S = S - 1 M = 12 End If Case Days To IIf(K = 0, 365, 366) - 1 'اگر تعداد روزهاي كاهش بيشتر از يك ماه و كمتر از يك سال باشد Subtract = Subtract - Days If M >= 2 Then M = M - 1 Else S = S - 1 M = 12 End If Case Else 'اگر تعداد روزهاي كاهش بيشتر از يك سال باشد S = S - 1 Subtract = Subtract - IIf(K = 0, 365, 366) End Select Wend SubtractDay = (S * 10000) + (M * 100) + ® End Function
پاسخ : جامع آموزش Access آموزش اکسس (بخش ششم) Join کردن بيش از ۲ جدول براي Database هاي Access کتاب ColdFusion MX Bible براي Join کردن بيش از دو جدول يک بانک اطلاعاتي راه حل زير را پيشنهاد مي کند: SELECT c.CompanyID, c.CompanyName, e.LastName, e.FirstName, e.Salary, d.FullName, d.RelationShip FROM Company c INNER JOIN Employee e ON c.CompanyID = e.CompanyID INNER JOIN Dependant d ON e.SSN = d.SSN که در بيشتر برنامه هاي Database Server درست عمل مي کند. اما در بانکهاي اطلاعاتي Microsoft Access پيغام خطايي با توضيح زير مي دهد : Operator expected من پس از يک کم جستجو در کتاب ها و پرسش از ديگران ، يک دوست آمريکايي من راه حل زير را پيشنهاد داد. در اکسس در برخي قسمت ها وجو د پارانتز الزامي است با اينکه در انواع ديگر بانک هاي اطلاعاتي نيازي به آن پارانتز ها نيست. يعني کد مورد نظر را بايد به صورت زير باز نويسي کنيم : SELECT c.CompanyID, c.CompanyName, e.LastName, e.FirstName, e.Salary, d.FullName, d.RelationShip FROM (Company c INNER JOIN Employee e ON c.CompanyID = e.CompanyID) INNER JOIN Dependant d ON e.SSN = d.SSN و يک نمونه ي ديگر در اتصال ۴ جدول : SELECT cfarticle.id, cfarticle.title, cfarticle.description, cfarticle.dateadded, editorial.authorname as author, categories.name, levels.levelname FROM ((cfarticle INNER JOIN categories ON cfarticle.category=categories.id) INNER JOIN editorial ON cfarticle.author=editorial.id) INNER JOIN levels ON cfarticle.skllevel=levels.id