PDA

مشاهده نسخه کامل : برنامه نويسي بانكهاي اطلاعاتي توسط اکسس(+آموزش اکسس)



Black Hawk
2006-Sep-10, 08:29
يك نرم افزار بانك اطلاعاتي كه در Access ايجاد مي شود به صورت يك فايل منفرد با پسوند mdb بر روي ديسك ذخيره ميشود و از اجزاي زير تشكيل ميشود.


1. Tables : جداول اطلاعاتي
2. Queries : پرس و جو ها
3. Forms : فرمها
4. Reports : گزارشها
5. Macros : ماكروها
6. Modules : ماژولها
1. Tables (جداول اطلاعاتي)
جداول اطلاعاتي حاوي مفيدترين اطلاعات به صورت جدولي يا سطري ستوني مي باشند . هر سطر ميتواند در بر گيرنده اطلاعات يك قلم كالا يا يك شخص خاص باشد كه به آن يك ركورد مي گويند .هر ستون يك جدول اطلاعاتي ، اطلاعات يك مشخصه خاص از آن ركورد را ذخيره ميكند كه به آن يك فيلد گفته ميشود مانند نام شخص ، شماره پرسنلي يك كارمند و يا كد يك كالا.

2. Queries (پرس و جو ها)

توسط Queryها ميتوان اطلاعات مورد نيازمان را از يك يا چند جدول اطلاعاتي استخراج كرد اين كار از طريق انتخاب جداول اطلاعاتي حاوي اطلاعات مورد نظر ، برقراري ارتباط بين جداول ، انتخاب فيلدهاي مورد نياز از جداول انتخاب شده و اعمال شرطهاي لازم روي فيلدها صورت ميگيرد.

3. Forms (فرمها)

فرمها در واقع رابط بين كاربر و اطلاعات ذخيره شده در جداول اطلاعاتي ميباشند . فرمها ميتوانند توسط كنترلهاي گرافيكي مانند جعبه متن ، جعبه ليست و ديگر كنترلهاي موجود در جعبه ابزار Access اطلاعات مورد نظر ما را از جداول اطلاعاتي نمايش دهند . و يا امكان اصلاح و افزودن ركورد به جداول اطلاعاتي را فراهم آورند. لازم به ذكر است كه هر فرم جهت انجام عمليات فوق روي داده ها از يك منبع داده استفاده ميكند كه منبع داده يك فرم را ميتوان يكي از جداول يا پرس و جوهاي موجود انتخاب كرد.

4. Reports گزارشها

توسط گزارشها ميتوان اطلاعات استخراج شده از جداول اطلاعاتي را در قالب و شكل دلخواه بر روي كاغذ چاپ كرد .

5. Macros (ماكروها)

ماكروها با به كارگيري يك سري توابع قدرتمند از قبيل نوشتن اطلاعات در يك ركورد جدول اطلاعاتي ، فراخواني اطلاعات از نرم افزارهاي بانك اطلاعاتي ديگر ، ارسال اطلاعات به فرمتهاي مورد نياز برنامه هاي ديگر و غيره امكان انجام يك سري عمليات مهم را به سادگي و با سرعت زياد فراهم ميآورند .

6. Modules (ماژولها)

هر ماژول ميتواند شامل يك يا چند تابع يا زيربرنامه باشد كه به صورت اختصاصي Private يا عمومي Public تعريف ميشوند همچنين ثوابت مورد استفاده در كليه فرمهاي برنامه را نيز ميتوان در اينجا به صورت Public تعريف كرد مانند:

Public Const cotation=""""
اين توابع را ميتوان از درون فرمهاي ديگر فراخواني كرد و يا در پرس و جوها و ماكروها از آنها استفاده كرد توابع بر خلاف زيربرنامه ها هميشه مقداري را به عنوان خروجي به برنامه فراخواننده باز ميگردانند . به عنوان مثال تابع زير با دريافت تاريخ توليد و مدت اعتبار يك فراورده ، تاريخ انقضاي آن را محاسبه و به برنامه فراخواننده برميگرداند .

[align=left:a712edd10b]
Public Function NextDate6(FirstDate As Variant, interval As Variant) As String
On Error GoTo Errhand
If Nz(FirstDate) = "" Then
NextDate6 =""
Else
Dim yy1, yy2, mm1, mm2, dd1 As String
Dim tm, vm, dy As Byte
yy1 = Left(FirstDate,2)
mm1 = Mid(FirstDate,3,2)
dd1 = Mid(FirstDate,5,2)
tm = interval + Val(mm1) - 1
vm = (tm Mod 12)
mm2 = Right("0" & Trim(Str(vm + 1)),2)
dy = (tm - vm) / 12
yy2 = Trim(Str(Val(yy1) + dy))
NextDate6 = yy2 & mm2 & dd1
End If
GoTo NoError
Errhand:
NextDate6 = ""
NoError:

End Function[/align:a712edd10b]
در تابع فوق جهت نگهداري تاريخ از يك فيلد نوع Text با طول 6 استفاده شده است با اين روش جهت نمايش تاريخ 850231 به صورت 85/02/31 ميتوان خاصيت Input Mask مربوط به فيلد تاريخ يا كنترل نمايش دهنده اين فيلد بر روي Form يا Report را به صورت 99/99/99 تنظيم كرد .

آقای تيمور هاشمي

halizadeh
2006-Sep-18, 19:30
كدنويسي وي بي در اكسس چه جوريه

ميشه يه مثال بزنيد

Black Hawk
2006-Sep-29, 08:39
halizadeh, برای اینکه بیشتر توضیح بدم از این به بعد آموزش کوتاه اکسس رو میزارم
تعريف كلي از اكسسAccess
اكسس ابزاري براي توليد بانكهاي اطلاعاتي رابطه اي است. بانكهاي اطلاعاتي امكان گردآوري انواع اطلاعات را براي ذخيره ‌سازي ،جستجو و بازيابي فراهم مي‌كند.

اجزا بانك اطلاعاتي اكسس عبارتند از:

DataBase:

1. Table
2. Query
3. Form
4. Report
5. Macros
6. Modules

• ‏‏Table :(جدول ) هر جدول براي نگهداري داده‌هاي خام بانك اطلاعاتي است.داده‌ها را شما در جدول وارد مي‌كنيد.جداول سپس اين داده‌ها را به شكل سطرها و ستونهايي سازماندهي ميكند.

• Query :هر پرس و جو براي استخراج اطلاعات مورد نظر از يك بانك اطلاعاتي مورد استفاده قرار مي‌گيردهر پرس و جو مي‌تواند گروهي از ركوردها را كه شرايط خاص دارا هستند انتخاب كند.پرس و جوها را مي‌توان بر اساس جداول يا پرس و جوهاي ديگر اماده نمود. با استفاده از پزس‌وجوها مي‌توان ركوردهاي بانك اطلاعاتي را انتخاب كرد، تغيير داد و يا حذف نمود.

• Form :متداولترين روش استفاده از فرمها،براي ورود و نمايش داده‌ها است.

• Report :گزارش ها مي‌توانند بر اساس جدول ،پرس‌وجوها باشند ،قابليت گزارش چاپ داده‌ها مي‌باشدگزارشها را مي‌توان بر اساس چند جدول و پرس‌وجو تهيه نمود تا رابطه بين داده‌ها را نشان داد.

• Macro :ماكروها به خودكار كردن كارهاي تكراري ،بدون نوشتن برنامه‌هاي پيچيده يا فراگيري يك زبان برنامه نويسي ، ياري مي‌كند، در واقع ماكروها يكسري قابليت‌هايي هستند كه امكان سريع سازي را فراهم مي‌سازند.

• Modules : محيط بسيار قوي و با كيفيت براي برنامه‌نويسي محاسبات و عمليات پيچيده روي سيستم بانك اطلاعاتي.
-----------------------------------
الف ‌- تعريف دادهData :
هرگونه اطلاعات لازم و كاربردي درباره يك موجوديت را يك داده مي‌گويند.

ب‌- تعريف Fild :
به هر ستون يك جدول كه در بر گيرنده كليه اطلاعات مربوط به آن ستون مي‌باشد و بخشي از يك موجوديت را تشگيل ميدهد فيلد گفته مي‌شود.

ت‌- تعريف Record :
به هر سطر يك جدول كه اطلاعات مربوط به يك موجوديت را نشان مي‌دهد ، ركورد گويند.

ث‌- تعريف پايگاه داده‌اي ارتباطي:
پايگاه داده‌هاي ارتباطي، مجموعه‌اي از جدول‌هاي داده است كه يك فيلد مشترك در هر يك از جدولهاي موجود دارد و از طريق آن مي‌توان داده‌ها را بهم ربط داد.به اين مدل از پايگاه داده‌ها ، پايگاه داده‌هاي ارتباطي RelationShip مي‌گويند.

Black Hawk
2006-Sep-29, 15:02
تابع تبديل عدد به حروف
مقدمه :
در اين يادداشت تابع مربوط به تبديل عدد به معادل حروفي آن ارائه مي كنم . عمدتا در سيستم هاي مالي و حسابداري نياز است معادل حروفي اعداد هم نمايش داده شده يا چاپ شوند كه توابع زير اين نياز را پاسخ مي دهد. مثلا براي چاپ يك چك روي خود برگه چك ، علاوه بر نياز به چاپ مبلغ عددي چك لازمست تا مبلغ حروفي چك هم روي برگه چاپ شود.

نحوه استفاده از تابع :
تابع Adad كه در زير ارائه شده است يك عدد را بعنوان ورودي گرفته و معادل حروفي آن عدد در زبان فارسي را بعنوان خروجي توليد مي كند. مثلا (Adad(1373 مقدار"يكهزار و سيصد و هفتاد و سه" را بعنوان خروجي توليد مي كند.براي استفاده از اين توابع بايد از چند خط پايين تر (Start of Module) تا انتهاي اين يادداشت را در حافظه كپي (Copy) كرده و در يك ماجول جديد در اكسس يا VB ، Paste كنيد . ( توجه داشته باشيد كه نمايش كدهاي نوشته شده در اينجا راست به چپ است كه پس از كپي كردن آن در ماجول اكسس بشكل صحيح نمايش داده خواهد شد)




' *********** Start of Module ***********

'توابع تبديل عدد به معادل حروفي آن در زبان فارسي
'برنامه نويس : حميد آزادي اردكاني


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&#40;I&#41; <> 0 Then
Select Case I
Case 1
S = S & Three&#40;K&#40;I&#41;&#41; & " تريليون"
Flag = True
Case 2
S = S & IIf&#40;Flag = True, " و ", ""&#41; & Three&#40;K&#40;I&#41;&#41; & " ميليارد"
Flag = True
Case 3
S = S & IIf&#40;Flag = True, " و ", ""&#41; & Three&#40;K&#40;I&#41;&#41; & " ميليون"
Flag = True
Case 4
S = S & IIf&#40;Flag = True, " و ", ""&#41; & Three&#40;K&#40;I&#41;&#41; & " هزار"
Flag = True
Case 5
S = S & IIf&#40;Flag = True, " و ", ""&#41; & Three&#40;K&#40;I&#41;&#41;
End Select
End If
Next I
Adad = S
End Function


Function Three&#40;ByVal Number As Integer&#41; As String
Dim S As String
Dim I, L As Long
Dim h&#40;1 To 3&#41; As Byte
Dim Flag As Boolean
L = Len&#40;Trim&#40;Str&#40;Number&#41;&#41;&#41;
If Number = 0 Then
Three = ""
Exit Function
End If
If Number = 100 Then
Three = "يكصد"
Exit Function
End If

If L = 2 Then h&#40;1&#41; = 0
If L = 1 Then
h&#40;1&#41; = 0
h&#40;2&#41; = 0
End If

For I = 1 To L
h&#40;3 - I + 1&#41; = Mid&#40;Trim&#40;Str&#40;Number&#41;&#41;, L - I + 1, 1&#41;
Next I

Select Case h&#40;1&#41;
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&#40;2&#41;
Case 1
Select Case h&#40;3&#41;
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&#40;2&#41; <> 1 Then
Select Case h&#40;3&#41;
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&#40;L < 3, Right&#40;S, Len&#40;S&#41; - 3&#41;, S&#41;
Three = S
End Function

halizadeh
2006-Sep-30, 08:34
سلام

ازتون ممنونم

اميدوارم موفق باشيد. :!:

Black Hawk
2006-Nov-27, 11:06
آموزش اکسس (بخش سوم)

در اين يادداشت روش غيرفعال كردن دكمه Shift به هنگام باز شدن فايلهاي اكسس را توضيح خواهم داد . در ابتدا بايد مقدمه اي را عنوان كنم.

مقدمه
مطلب زير در زمينه افزايش امنيت سيستم ها است. نكته اي كه در زمينه امنيت هر نوع سيستمي بايد به آن توجه داشت اينست كه بطور كلي امنيت يك امر نسبي است .
بعبارت ديگر يك راه حل امنيتي ، قطعا جلوي بسياري از حملات عليه سيستم را خواهد گرفت ولي هيچگاه بطور كامل حملات را خنثي نخواهد كرد و هميشه حفره هاي امنيتي وجود خواهند داشت .
در يادداشت قبل گفتيم كه به هنگام باز شدن فايلهاي اكسس، Startup اجراء مي شود . به كمك گزينه هاي Startup مي توانيم از دسترسي كاربران به محيط طراحي برنامه جلوگيري كنيم . ولي همانطور كه قبلا گفته شد ميكرو سافت با انگيزه ايجاد سيستم امنيتي چند مرحله اي يك روش ضد امنيتي براي آن ايجاد كرده است و كاربران برنامه ما مي توانند با پايين نگه داشتن دكمه Shift از اجراء Startup جلوگيري كنند و وارد محيط طراحي شوند . حال اگر بخواهيم دكمه شيفت را غير فعال كنيم تا كسي نتواند وارد محيط طراحي شود بايد به اين طريق عمل كرد :

استفاده از خاصيت AllowByPassKey
خاصيت AllowByPassKey يكي از خواص شيء Database است كه:
اگر مقدار آن True باشد دكمه شيفت فعال است .
و اگر مقدار آن False باشد دكمه شيفت غير فعال است .

اين خاصيت عملا در ليست خواص يك Database نيست و بايد آنرا فقط براي اولين بار ايجاد (Create) كرد . بعد از ايجاد آن مي توان مقدار آنرا False يا True كرد .

تذكر : حتما يك كپي از فايل خودتان قبل از اجراء اين برنامه برداريد چون ممكن است ديگر نتوانيد وارد محيط برنامه خودتان شويد . من هم با عرض معذرت وقت پاسخگويي به ايميل هاي دوستان را ندارم و دچار مشكل خواهيد شد.

سه دكمه روي يك فرم مطابق شكل بالا ايجاد كنيد و كدهاي زير را در آن بنويسد.
(نمايش كدهاي نوشته شده مناسب نيست ولي اگر آنرا در حافظه كپي كنيد و در ماجول فرمتان كپي كند بدرستي تمايش داده مي شود .)



'براي اولين دفعه :

Private Sub Create_Click&#40;&#41;
On Error GoTo Er

Dim db As Database
Dim prp As Property
Set db = CurrentDb
Set prp = db.CreateProperty&#40;"allowbypasskey", dbBoolean, False&#41;
db.Properties.Append prp
db.Close

Ex&#58;
Exit Sub
Er&#58;
If Err.Number = 3367 Then
MsgBox "اين خاصيت ايجاد شده و لازم نيست مجددا ايجاد شود"
End If
Resume Ex

End Sub

'جهت غير فعال كردن شيفت

Private Sub ShiftNo_Click&#40;&#41;
Dim db As Database
Set db = CurrentDb
db.Properties&#40;"allowbypasskey"&#41; = False
db.Close
End Sub

'جهت فعال كردن شيفت

Private Sub ShiftOk_Click&#40;&#41;
Dim db As Database
Set db = CurrentDb
db.Properties&#40;"allowbypasskey"&#41; = True
db.Close
End Sub

Black Hawk
2006-Dec-01, 10:58
صدور پيغامهاي فارسي بجاي پيغامهاي 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=..t

Msgbox Str
Response = acDataErrContinu.
....
End Selece



2- اگر خطا مربوط به كدهايي باشد كه خودمان در يك Sub نوشته ايم :
در اين روش بايد در ابتداي Sub با دستور : <اسم زير روال كنترل خطا> On Error Goto ، كنترل خطا را به يك روال كنترل خطا ارجاع دهيم.
( تمام كدهايي كه ويزارد Command Button بطور خودكار در رويداد OnClick دكمه ها ايجاد مي كند نمونه خوبي براي اين روش هستند. ضمنا در اين روش بكمك Err.Number كد خطا شناسايي مي شود )

Black Hawk
2006-Dec-06, 19:05
ماجول تاريخ هجري شمسي با توابع جانبي آن
در بانك اطلاعاتي Access فيلدهاي نوع Date پاسخگوي نياز كاربران فارسي كه با تاريخ هجري شمسي كار مي كنند نيست . البته برنامه هايي مثل پارسا ۹۹ تقويم سيستم را به تقويم هجري شمسي تبديل مي كند و بعد از آن كاربران فارسي مي توانند از فيلدهاي نوع Date اكسس استفاده كنند .بدين ترتيب پارسا مشكل تاريخ هجري شمسي را حل ميكند ولي بعضا تاريخ شمسي سيستم بنا به دلايلي از بين ميرود . مثلا اگربعد از نصب پارسا، Officeنصب شود تاريخ هجري شمسي سيستم به هم مي خورد. براي رهايي از وابستگي برنامه هاي شما به پارسا و ... ، توابع زير مي تواند مشكل شما را بطور كامل حل كند .
اين ماجول در چندين برنامه تست شده و جواب گرفته است شما هم مي توانيد از آن استفاده كنيد.
(توجه داشته باشيد كه كدهاي نوشته شده ، در اينجا از چپ به راست نمايش داده شده اند ولي با كپي آن در اكسس ، نمايش آن از چپ به راست خواهد شد)

در صورت استفاده از اين ماجول ، فيلدهاي از نوع تاريخ را بايد از نوع Number تعريف كنيد. توضيحات بيشتر جهت استفاده از ماجول ، درون خود ماجول نوشته شده است.
براي استفاده از اين ماجول ، از دو خط پايين تر تا انتهاي متن را در حافظه كپي كرده (Copy) و سپس در يك ماجول جديد در اكسس يا VB قرار دهيد (Paste):



' ************************************************** ***********
' برنامه نويس : حميد آزادي

' ************************************************** ***********



' 1- تعريف كنيد Number(Long) است را بصورت Date فيلدهايي كه نوع آنها
' 2- اين فيلدها را بصورت 00/00/00 تنظيم كنيد InputMask خاصيت
' بدليل 6 رقمي در نظر گرفتن فيلد تاريخ ، اين توابع تا سال 1399 كارايي دارد
' ...
' تاريخ جاري سيستم را به هجري شمسي تبديل مي كند Shamsi() تابع
' بكار ببريد Now() را مي توانيد در گزارشات بجاي تابع Dat() تابع
' :براي جلوگيري از ورود تاريخ غلط به درون يك فيلد بترتيب زير عمل ميكنيد
' :بشكل زير بكار ببريد ValidationRule را در خاصيت ValidDate() تابع
' ValidDate([نام فيلد])=True
' ...




'*******************************************
Public Function Rooz&#40;F_Date As Long&#41; As Byte
'اين تابع عدد مربوط به روز يك تاريخ را برمگرداند
Rooz = F_Date Mod 100
End Function
'*******************************************
Function Mah&#40;F_Date As Long&#41; As Byte
'اين تابع عدد مربوط به ماه يك تاريخ را برمگرداند
Mah = Int&#40;&#40;F_Date Mod 10000&#41; / 100&#41;
End Function
'*******************************************
Public Function Sal&#40;F_Date As Long&#41; As Byte
'اين تابع عدد مربوط به سال يك تاريخ را برمگرداند
Sal = Int&#40;F_Date / 10000&#41;
End Function
'*******************************************
Public Function Kabiseh&#40;ByVal OnlySal As Variant&#41; As Byte
'ورودي تابع عدد دورقمي است
'اين تابع كبيسه بودن سال را برميگرداند
'اگر سال كبيسه باشد عدد يك و درغير اينصورت صفر را بر ميگرداند
Kabiseh = 0
If OnlySal >= 75 Then
If &#40;OnlySal - 75&#41; Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
ElseIf OnlySal <= 70 Then
If &#40;70 - OnlySal&#41; Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
End If

End Function
'*******************************************
Function ValidDate&#40;F_Date As Long&#41; As Boolean
Dim M, S, R As Byte
' اين تابع اعتبار يك عدد ورودي را از نظر تاريخ هجري شمسي بررسي مي كند
' را برمي گرداند False واگر نامعتبر باشد True اگر تاريخ معتبر باشد
ValidDate = True
S = Sal&#40;F_Date&#41;
M = Mah&#40;F_Date&#41;
R = Rooz&#40;F_Date&#41;
'********
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&#40;S, M&#41; Then
ValidDate = False
Exit Function
End If
End Function
'*******************************************
Public Function AddDay&#40;ByVal F_Date As Long, ByVal add As Integer&#41; As Long
Dim K, M, S, R, Days As Byte
R = Rooz&#40;F_Date&#41;
M = Mah&#40;F_Date&#41;
S = Sal&#40;F_Date&#41;
K = Kabiseh&#40;S&#41;

'تبديل روز به عدد 1 جهت ادامه محاسبات و يا اتمام محاسبه
Days = MahDays&#40;S, M&#41;
If add > Days - R Then
add = add - &#40;Days - R + 1&#41;
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&#40;S&#41; 'كبيسه&#58; 1 و غير كبيسه&#58; 0
Days = MahDays&#40;S, M&#41; 'تعداد روزهاي ماه فعلي
Select Case add
Case Is < Days
'اگر تعداد روزهاي افزودني كمتر از يك ماه باشد
R = R + add
add = 0
Case Days To IIf&#40;K = 0, 365, 366&#41; - 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&#40;K = 0, 365, 366&#41;
End Select
Wend
AddDay = &#40;S * 10000&#41; + &#40;M * 100&#41; + &#40;R&#41;

End Function

'***********************************************
Public Function Shamsi&#40;&#41; 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&#40;"d", Miladi_mabna, Date&#41;
If Dif < 0 Then
MsgBox "تاريخ جاري سيستم شما نادرست است , آنرا اصلاح كنيد."
Else
Shamsi = AddDay&#40;Shamsi_Mabna, Dif&#41;
End If
End Function
'***********************************************
Public Function DayWeek&#40;F_Date As Long&#41; As String
Dim a As String
Dim N As Byte
N = DayWeekNo&#40;F_Date&#41;
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&#40;&#41;
Dim D As Long
D = Shamsi
Dat = DayWeek&#40;D&#41; & " 13" & Sal&#40;D&#41; & "/" & Mah&#40;D&#41; & "/" & Rooz&#40;D&#41;
End Function

'***********************************************
Public Function Diff&#40;ByVal FromDate As Long, ByVal To_Date As Long&#41; 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&#40;FromDate&#41; = True Or To_Date = 0 Or IsNull&#40;To_Date&#41; = 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&#40;FromDate&#41;
M1 = Mah&#40;FromDate&#41;
S1 = Sal&#40;FromDate&#41;
r2 = Rooz&#40;To_Date&#41;
m2 = Mah&#40;To_Date&#41;
S2 = Sal&#40;To_Date&#41;
Sumation = 0

Do While S1 < S2 - 1 Or &#40;S1 = S2 - 1 And &#40;M1 < m2 Or &#40;M1 = m2 And r1 <= r2&#41;&#41;&#41;
'اگر يك سال يا بيشتر اختلاف بود
If Kabiseh&#40;&#40;S1&#41;&#41; = 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 &#40;M1 = m2 - 1 And r1 < r2&#41;
'اگر يك ماه يا بيشتر اختلاف بود
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&#40;S1&#41; = 0 Then
Sumation = Sumation + 29
r1 = 29
Else
Sumation = Sumation + 30
End If
M1 = M1 + 1
Case 12
If Kabiseh&#40;S1&#41; = 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 + &#40;r2 - r1&#41;
Else
Select Case M1
Case 1 To 6
Sumation = Sumation + &#40;31 - r1&#41; + r2
Case 7 To 11
Sumation = Sumation + &#40;30 - r1&#41; + r2
Case 12
If Kabiseh&#40;S1&#41; = 1 Then
Sumation = Sumation + &#40;30 - r1&#41; + r2
Else
Sumation = Sumation + &#40;29 - r1&#41; + r2
End If
End Select
End If

If Flag = True Then
Sumation = -Sumation
End If
Diff = Sumation
End Function

Public Function DayWeekNo&#40;F_Date As Long&#41; 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&#40;Shmsi_Mabna, F_Date&#41;
If Shmsi_Mabna > F_Date Then
Dif = -Dif
End If
'با توجه به اينكه 80/10/11 3شنبه است محاسبه ميشود day متغير
day = &#40;Dif + 3&#41; Mod 7
If day < 0 Then
DayWeekNo = day + 7
Else
DayWeekNo = day
End If
End Function


Function MahName&#40;ByVal Mah_no As Byte&#41; 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&#40;ByVal F_Date As Long&#41; As Integer
'چهار رقم اول تاريخ كه معرف سال و ماه است را برمي گرداند
SalMah = Val&#40;Left$&#40;F_Date, 4&#41;&#41;
End Function

Function MahDays&#40;ByVal Sal As Byte, ByVal Mah As Byte&#41; As Byte
'اين تابع تعداد روزهاي يك ماه را برمي گرداند
Select Case Mah
Case 1 To 6
MahDays = 31
Case 7 To 11
MahDays = 30
Case 12
If Kabiseh&#40;Sal&#41; = 1 Then
MahDays = 30
Else
MahDays = 29
End If
End Select

End Function

Function Make_Date&#40;ByVal F_Date As Long&#41; As String
'يك تاريخ را بصورت يك رشته 10 رقمي با ذكر چهار رقم براي سال ارائه مي كند
Dim D As String
D = Trim&#40;Str&#40;F_Date&#41;&#41;
If IsNull&#40;F_Date&#41; = True Or F_Date = 0 Then
Make_Date = ""
Else
Make_Date = "13" & Mid&#40;D, 1, 2&#41; & "/" & Mid&#40;D, 3, 2&#41; & "/" & Mid&#40;D, 5, 2&#41;
End If
End Function

Function NextMah&#40;ByVal Sal_Mah As Integer&#41; As Integer
If &#40;Sal_Mah Mod 100&#41; = 12 Then
NextMah = &#40;Int&#40;Sal_Mah / 100&#41; + 1&#41; * 100 + 1
Else
NextMah = Sal_Mah + 1
End If
End Function

Function PreviousMah&#40;ByVal Sal_Mah As Integer&#41; As Integer
If &#40;Sal_Mah Mod 100&#41; = 1 Then
PreviousMah = &#40;Int&#40;Sal_Mah / 100&#41; - 1&#41; * 100 + 12
Else
PreviousMah = Sal_Mah - 1
End If
End Function


Function SubtractDay&#40;ByVal F_Date As Long, ByVal Subtract As Long&#41; As Long
'به تعداد روز معيني از يك تاريخ كم كرده و تاريخ حاصله را ارائه ميكند
Dim K, M, S, R, Days As Byte

R = Rooz&#40;F_Date&#41;
M = Mah&#40;F_Date&#41;
S = Sal&#40;F_Date&#41;
K = Kabiseh&#40;S&#41;

'تبديل روز به عدد 1 جهت ادامه محاسبات و يا اتمام محاسبه
If Subtract >= R - 1 Then
Subtract = Subtract - &#40;R - 1&#41;
R = 1
Else
R = R - Subtract
Subtract = 0
End If

While Subtract > 0
K = Kabiseh&#40;S - 1&#41; 'كبيسه&#58; 1 و غير كبيسه&#58; 0
Days = MahDays&#40;IIf&#40;M >= 2, S, S - 1&#41;, IIf&#40;M >= 2, M - 1, 12&#41;&#41; 'تعداد روزهاي ماه قبلي
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&#40;K = 0, 365, 366&#41; - 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&#40;K = 0, 365, 366&#41;
End Select
Wend
SubtractDay = &#40;S * 10000&#41; + &#40;M * 100&#41; + &#40;R&#41;

End Function

mb_bar
2007-Jan-04, 22:39
سلام و خسته نباشيد

من در برنامه اکسس یک فرم با سه تب درست کرده ام و در تب های اول و دوم اطلاعاتی از بانک اطلاعاتی برنامه نمایش داده میشود. در تب سوم میخواهم یک فایل pdf را (بسته به انتخاب کاربر در قسمتهای قبلی برنامه) به نمایش بگذارم بطوریکه بمحض کلیک بر روی تب سوم برنامه آکروبات ریدر در داخل کنترل اکتیوایکس برنامه Acrobat Reader - درج شده بر روی تب سوم - فایل مورد نظر را نمایش میدهد. برای این منظور از طریق مقداردهی SRC از طریق کد ویژوال بیسیک فایل مورد نظر نمایش داده میشود ولی مشکلم اینجاست که وقتی پس از نمایش فایل بر روی تبهای قبلی کلیک میکنم دیگر نمیتوانم با کلیک مجدد بر روی تب سوم فایل پی دی اف را مشاهده نمایم و با خطای زمان اجرای Automasion Error مواجه میشوم خواهشمندم در این مورد مرا راهنمائی فرمائید.
متن کامل خطا :
Run-time error '-2147417848 (8001008)
Automation error
The object invoked has disconnected from its clients.

MasterData
2007-Jan-05, 09:51
البته من نه وي بي بلدم نه با اكسس اپليكيشن مي نويسم
ولي جوري كه از پيام خطا بر مي ياد شما شي رو از دست دادين برا همين نمي تونيد بهش مقدار دهي كنيد
چك كنيد هنگام خروج از تب كار خاصي رو اكتويس انجام نمي دين؟

mb_bar
2007-Jan-06, 09:02
MasterData ممنون كه به سئوالم توجه كردين
ببينيد اين مشكل وقتي كنترل اكتيوايكس رو روي يك فرم تكي قرار ميدم وجود ندارد. ولي در مورد اين برنامه حتما بايد از كنترل تب استفاده كنم. چون اطلاعات ديگري از بانك اطلاعاتي برنامه در تبهاي قبلي بايد نمايش داده شود.

منتظر پاسخ دوستان عزيز هستم.

source computer
2007-May-06, 23:06
اقا مرسي به دردم خورد يه ژروجه رو انجام دادم البته خيلي خيلي توش تغير ايجاد كردم البته من ماژول بهش

اضافه كردم كه باعث شد كه برنامه شلوغ نشه

saadatirad
2007-Jul-27, 00:32
سلام
آموزشتون خیلی خوبه ولی از اردیبهشت تا حالا چرا ادامه ندادید
در ضمن من یك برنامه برای كتابخانه نوشتم كه دیركرد اوردن كتاب را محاسبه می كند و حالا می خواهم اگر تا سه روز اورد كه هیچ ولی اگر بیشتر از 3 روز و كمتر از یك هفته اورد ضربدر 50 تومان جریمه و اگر بیشتر از یك هفته شد ضربدر 100 تومان جریمه شود می خواهم جواب ان بصورت تكست باكس در فرم دیده شود
ممنون می شوم راهنمایی كنید

Black Hawk
2007-Jul-29, 21:20
این کتاب رو از کتابخانه سایت دریافت کنید شاید مشکلتون بر طرف بشه
http://www.daneshju.ir/forum/downloads.php?do=file&id=154

nima1986
2009-Oct-23, 10:18
سلام من عضو جدید این سایتم و از مدیران و اعضای این سایت بابت مطالب با ارزش دراین سایت تشکر می کنم
سئوالی داشتم درباره کمبو باکس یا لیست باکس مثلا من چند تا کوئری دارم و توسط کمبو باکس می خواهم آنها را صدا بزنم مثلا در کمبو جداول الف و ب و ت و ث دارم و در کمبویا منوی کرکره این اسامی جداول کوئری وجود دارد چطوری می توان تمامی اطلاعات جداول را آورد

ramilakaren
2011-Jul-18, 10:58
سلام من عضو جدید این سایت هستم از دوستان تقاضا دارم هرچی در مورد اکسس و برنامه نویسی با آن میدانند برای من ایمیل کنند

ramila.karen@gmail.com

fatemeh_arami
2011-Oct-21, 12:41
سلام
آموزشتون خیلی خوبه ولی از اردیبهشت تا حالا چرا ادامه ندادید
در ضمن من یك برنامه برای كتابخانه نوشتم كه دیركرد اوردن كتاب را محاسبه می كند و حالا می خواهم اگر تا سه روز اورد كه هیچ ولی اگر بیشتر از 3 روز و كمتر از یك هفته اورد ضربدر 50 تومان جریمه و اگر بیشتر از یك هفته شد ضربدر 100 تومان جریمه شود می خواهم جواب ان بصورت تكست باكس در فرم دیده شود
ممنون می شوم راهنمایی كنید
salam age mishe source in barnamaton ro behem bedid mer30

fatemeh_arami
2011-Oct-21, 12:42
سلام
آموزشتون خیلی خوبه ولی از اردیبهشت تا حالا چرا ادامه ندادید
در ضمن من یك برنامه برای كتابخانه نوشتم كه دیركرد اوردن كتاب را محاسبه می كند و حالا می خواهم اگر تا سه روز اورد كه هیچ ولی اگر بیشتر از 3 روز و كمتر از یك هفته اورد ضربدر 50 تومان جریمه و اگر بیشتر از یك هفته شد ضربدر 100 تومان جریمه شود می خواهم جواب ان بصورت تكست باكس در فرم دیده شود
ممنون می شوم راهنمایی كنید
salam age mishe source in barnamaton ro behem bedid mer30

masoudtg
2012-Jan-03, 19:01
سلام به همه
من دو جدول دارم====> 1.لیست اعضا کتابخانه(نام-نام خانوادگی-عکس فرد-غیره) 2.جدول امانتی ها(شماره عضویت-شماره کتاب-تاریخ امانت-تاریخ برگشت)
از جدول 2 یک فرم معمولی درست میکنم --
تو فرم می خوام وقتی که شماره عضویت عضو را وارد میکنم(برای کتاب دادن) تو یه گروه تکست باکس نام-نام خانوادگی-----وعکس عضو رو نشون بده؟؟؟؟؟؟؟؟؟؟؟؟