کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

به اشتراک گذاری اطلاعات کسب شده در اکسس از سایت آفیس و سایت های تخصصی خارجی
کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

به اشتراک گذاری اطلاعات کسب شده در اکسس از سایت آفیس و سایت های تخصصی خارجی

حذف فیلتر/اعمال فیلتر



برای حذف فیلترهای اعمال شده در جدول ، کوئری یا مجموعه ای از رکوردها در فرم یا سابفرم از متد زیر استفاده می شود.



DoCmd.ShowAllRecords





برای فیلتر کردن فرضا مجموعه ای از رکوردها در سابفرم یا کانتینیوس فرم از متد زیر استفاده خواهیم کرد . در کل برای رکوردهای جدول کوئری فرم فعال و فوکس شده . زمان لود شدن آبجکت بصورت اتومات اعمال میشوند بنابراین پراپرتی FilterOnLoad را برابر True قرار دهید.      


کد زیر آبجکت فعال را فیلتر می کند تا اینکه فقط رکوردهایی را نمایش دهد که با NWTB شروع شوند .

_  " Docmd.SetFilter , "[Product Code] Like
"""*NTWB"

از Docmd.ApplyFilter هم میتوان بهره برد.

اعتبارسنجی تاریخ شمسی


Function CheckValidShamsiDate(Dt) As Boolean 

اگر فرمت بدین شکل باشد و / در فیلد ذخیره شود و سال هم چهار رقمی باشد               0000/00/00

 

((Y=Val(Mid(Dt,1,4

((M=val(Mid(Dt,6,2

((D=Val(Mid(Dt,9,2


If Y<1 And Y>2500 Then

CheckValidShamsiDate=False

End if


Select Case M 

     Case 1 To 6 

        If D>31 And D<1 Then 

         CheckValidShamsiDate=False

       End if 

      Case 7 To 11

      If D>30 And D<1 Then 

        CheckValidShamsiDate=False

      End if

     Case 12 

     If KabisehShamsi(Y)=True Then

    If D>30 And D<1 Then CheckValidShamsiDate=False  

Else if KabisehShamsi(Y)=False 

    If D>29 Abd D<1 Then CheckValidShamsiDate=False  

        End if

End Select


تابع بالا را میتوان در رویداد Exit تکست باکس نوشت که اگر False شد Cancel برابر True شود. چک کردن سال کبیسه ی شمسی هم مفصل در جای دیگر بحث شده.

بلنک رکورد یا لاین خالی در گزارش ( حقه )



برامون پیش اومده که وقتی فاکتور صادر می کنیم میخواهیم  یه چیزی شبیه فاکتور باشه یا مثل اکسل ردیف ها را تا آخر در پرینت ببینیم ... فرض کنید شما تو فاکتورتون ۳ آیتم داریم ولی خط و خطوط باید تا پائین صفحه ی گزارش رسم بشه اگر نخواهید کنترل ها را بصورت Grow استفاده کنید ( منظور اگر شرح بیشتر شد از عرض کنترل اون کنترل  تعریض یا اکسپند میشه تا محتویاتش رو راحت ببینیم )  می تونید امتحان کنید که در ارتفاع دیتیل در گزارش چقدر لاین جا می گیره به نسبتش یه کوئری ایجاد می کنید با آیدی از فرضا 1 تا ۴۰ و فیلدی  که تماما خالیه بعد زمان باز شدن گزارش می گید که اون منبع گزارشتون با کوئری ساخته شده تجمیع بشه Union و بعد در شرط کوئری که ساختید و در یونیون استفاده می کنید می نویسید که  آیدی  هایی رو لیست کنه که کانت منبع گزارش ( با استفاده از تابع Dcount )  


فرض مثال جدول  فاکتور شامل فیلدهای زیر باشد 

FactorNo PartNo Desc Qty UnitPrice Totals 

ایجاد جدول بصورت  بنام BlankFactor شامل فیلدهای 

BlankId BlnkDesc 

در یونیون حتما باید تعداد فیلدهای جدول یکی باشن اسامی فیلدها مهم نیست فقط دیتا تایپشون مغایرت نداشته باشه !!!


Select * From tblFactor 

                      Union All

در سلکت زیر چون بایدتعداد فیلدها با تعداد فیلدهای سلکت بالائی یکی شود به تعداد باقیمانده از دابل کوتیشن استفاده کردیم 

 "","","","","",Select BlankDesc

Where BlankId>Dcount("*","tblFactor,"FactorID=" & tblFactor.FactorNo  


در مثال فوق اگر شماره ی فاکتور را از باکسی در فرم بگیرد باید در شرط جای tblFactor.FactorNo آدرس کنترل در فرم یا سابفرم اعمال شود در اینجا شماره فاکتور ، دیتا تایپ  نامبر گرفته شده که سرعت بالاتری در سرچ نسبت به دیتا تایپ تکست دارد 


Forms!Form1!txtFactorNo

پراپرتی نمایش بلنک رکورد در گزارش


Report.NextRecord Property


Property NextRecord مشخص می کند که آیا سکشن مربوطه باید به رکورد بعدی پیش برود یا خیر که بصورت Boolean هست و در رویداد OnFormat قرار داده می شود .


پراپرتی مهم و کم کاربرد است 


فرض کنید هر ۱۰ خط یا Line را در گزارش ( پرینت پرویو ) می خواهید جدا کنید ( توضیح واضح تر بعد از هر رکورد یک جای خالی باقی بگذارد یعنی به رکورد بعدی پیش نرود و بعد از آن لاین خالی دوباره رکوردها نمایش یابند ) یک کانتر در رویداد OnPrint دیتیل آن درست می کنید که اگر اون کانتر Mod ده برابر صفر شد NextRecord ترو شود PrintSection را هم می توانید ترو کنید ... برای ریست شدن کانتر از رویداد Format سکشن Header استفاده کنید که کانتر را صفر کند.


  البته در مورد بالا باید یک نشانگر قرار دهید که اگر آن نشانگر برابر False شد آن سکشن رکوردها را طبق کانتر نمایش دهد و در صورتیکه به ۱۰ رسید به رکورد بعدی نرود و جای خالی بیاندازد یا بعبارتی  رکورد بعد از لاین ۱۰ در خط بعد از آن جای خالی قرار گیرند. (   وقتی امتحان کنید لاین  بعدی که نباید رکورد بعد از ده قرار گیرد همان  تکرار رکورد ۱۰ است )

ایجاد کوئری در اکسس QueryDef


شی QueryDef یک تعریف ذخیره شده ای از کوئری در موتور دیتابیس اکسس هست که ازآن برای ساخت کوئری استفاده خواهد کرد . ( و حتی مقداردهی پارامتر ) 


Dim Qry As QueryDef

Set Qry=CurrentDb.CreateQueryDefs("Select * From

("Table1 Where Id>=14

استفاده از پارامتر 

Dim qdf As QueryDef

("Set qdf = dbs.QueryDefs("myActionQuery

                            Set the value of the QueryDef's parameter'

تنظیم مقدار یا مقداردهی پارامتر

_ =qdf.Parameters("Organization").Value

"Microsoft"

کامندهای اجرائی در اکسس RunCommand

....Docmd.Runcommand acCmd


acCmdZoom100

acCmdUndo

acCmdSelectRecord

acCmdSelectAll

acCmdSaveRecord

acCmdRowHeight

acCmdRemoveAllFilters

acCmdRefresh

acCmdRedo

برای سابفرم نه رکوردست از این فرامین استفاده می کنیم 

acCmdRecordsGoToFirst

acCmdRecordsGoToLast

acCmdRecordsGoToNew

acCmdRecordsGoToNext

acCmdQueryTotals

acCmdPrintPreview

acCmdPrint

برای استفاده در شورت کات منوی ساخته شده در دیتا شیت توسط خودتان 

acCmdCopy

acCmdCut

acCmdPaste

acCmdDelete

acCmdLayoutView

acCmdFind    باکس Search Find 

acCmdExportText

acCmdExportAccess

acCmdDesignView

acCmdDeleteRecord

acCmdDeleteRows

acCmdDataEntry

acCmdControlMarginsNarrow

acCmdCloseDatabase

acCmdCloseWindow

acCmdCloseAll

acCmdClearAll

acCmdChangeToComboBox

   در دیزاین فقط میشود کنترلی را تغییر داد پس تلاش نکنید در ویو استفاده کنید 

acCmdAppMaximize

acCmdAppMinimize

acCmdAppMove

acCmdAppRestore

ساخت شورتکات منو در اکسس ۲۰۱۶



شورتکات : 

سه تا کامند باتن در کامندباربصورت MsoPopup برای پرینت ، رفرش و بستن فرم ContactList




اسم ماکروی بالا mcrAddShortcutMenu را در قسمت پراپرتی ShortCutMenu تایپ می شود با AddMenu در Add-In ریبون قابل مشاهده هست.



کامند باتن در CommandBar و ساب منو بهمراه کامند ها



بصورت زیر نمایان خواهد شد. برای ایجاد ساب منو در تصویر بالا  از AddMenu استفاده شده و یک ماکروی با نام SubMenuCommands با فرمان ساب ماکرو داخلش ساخته شده و در MacroName اظهارشده .



 در باکس ادیت  SubMacro می توان  از کلیدهایی برای انجام کارهائی استفاده کرد یا عملکرد آنها را غیر فعال کرد  فرضا     p^ منظور Ctrl+p هست  فرضا شما می خواهید فرمان انجام نشود در نتیجه در خط بعدی CancelEvent را می توانید انتخاب و ماکرو را با عنوان AutoKeys ( فقط به این نام ) ذخیره کنید.


در سطح پیشرفته تر یعنی استفاده از Commandar.Controls Properties باید حتما از رفرنس Microsoft Object Library انتخاب شود تا بتوانید از  پراپرتیهای آن استفاده نمائید.


https://docs.microsoft.com/en-us/office/vba/api/office.commandbar.controls


سطح دسترسی User Level

نمونه ای از سطح دسترسی 



()Private Sub Form_Load
Dim sPermit As String
Dim iAccess As Integer
Dim Ctl As Access.Control
("Me.txtUser = Environ("username
If IsNothing(Me.txtUser) The
"sPermit = "ReadOnly
Else
"sPermit = "ReadOnly
Select Case sPermit
(sPermit = GetPermission(Me.txtUser
End If
iAccess = 3
"Case "Edit
iAccess = 2
"Case "Admin
Me.txtLevel = iAccess
Case Else
iAccess = 1
End Sub
End Select


()Private Sub Form_Load
If Forms!frmMenu!txtLevel < 11 Then
Me.AllowEdits = False
Else
Me.AllowEdits = True
End If
End Sub
(Private Function GetPermission(sUser As String
_ & "'= If (IsNothing(DLookup("Permissions", "tblStaff", "Login
Forms!frmmenu!txtUser & "'"))) Then
"GetPermission = "ReadOnly
Else
_ & "'=GetPermission = DLookup("Permissions","tblStaff","Login
"'" & Forms!frmmenu!txtUser
End if
End Function


نمونه ی تصویری



جستجو ( DlookUp )در جدول یا کوئری

مثال زیر از متغیر intSearch برای گرفتن مقدار ( عددی ) استفاده می کند که بعنوان integer یعنی حدود ۵ رقم نهایتا تعریف میشود اگر عدد بزرگتر باشد از Long استفاده کنید 

نکته : در پنجره ی immediate window وقتی میخواهید عددی را در عدد دیگری ضرب کنید چون پیش فرض integer می گیرد پیغام Overflow را نمایش می دهد که باید آنرا به Long تبدیل یا Convert کنید فرضا      200 *(Clng(1356 ?


Dim intSearch As Integer
Dim varX As Variant
intSearch = 1
_ ,"varX = DLookup("[CompanyName]", "Shippers
("[ShipperID] = " & intSearch]"

در مورد بالا نام کمپانی را از جدول/ کوئری Shippers درصورتیکه مقدار ShipperID آن برابر متغیر اظهارشده بود( یعنی یک ) بازیابی میکند اگر Null باشد ارور Null را بر می گرداند پس صحیح است که بعد ازآن به نمونه روش ذیل عمل کنیم

If IsNull(Varx) =False Or Varx<>"" Then
End if

اگر شرط مورد جستجو عدد نبود یعنی تکست یا به قولی متنی باید شرط بصورت زیر تغییر یعنی تک کوتیشن به اول و آخر عبارت اضافه میشود " ' عبارت ' "

"'=Dlookup("CompanyName","Query1","FamilyName
"'" & Me.TxtSearch &
در مثال فوق اسم شرکت از کوئری یک را بازیابی می کند زمانیکه مقدار txtSearch که تکست هست با فیلد FamilyName برابر باشد. اگر txtSearch در سابفرم باشد باید به آن ارجاع داد فرضا فرم اصلی را MainForm و اسم سابفرمی که txtSearch در آن وجود دارد Sub1 درنظر بگیرید .

& "'=FamilyName"
"'" & Forms!MainForm!Sub1.Form!TxtSearch

بعد از Sub1 از Form استفاده کردیم چرا ؟ چون سابفرم خودش از دو لایه تشکیل شده لایه ی اول پراپرتی های مربوط به خود سابفرم است مثل LinkMaster یا LinkChild و شامل کنترهای مربوط به فرم نیست و بعدی مربوط به فرم که شامل سکشن ها منظور دیتیل و هدر و کنترل هاست
  • Byte — For integers that range from 0 to 255. Storage requirement is a single byte.

  • Integer — For integers that range from -32,768 to +32,767. Storage requirement is two bytes.

  • Long Integer — For integers that range from -2,147,483,648 to +2,147,483,647. Storage requirement is four bytes.

انتخاب آبجکت

مثال زیر فرم را انتخاب می کند 


DoCmd.SelectObject acForm, "Customers", True


تغییر نام آبجکت ( فرم ، جدول ، کوئری )


Docmd.Rename NewName,ObjectType,OldName


از متد Rename برای تغییر نام شئ دیتابیس مشخص شده مثل جدول یا کوئری بهره ببرید


Use the Rename method to rename a specified database object.


اگر ObjectType و آرگومان OldName خالی بمانند ( پس با توجه به این گفته هر دو Optional یا انتخابی هستند و می توانند خالی رها شوند - پیش فرض acDefault است یعنی هر چی که انتخاب شده بود ) اکسس آبجکت یا شئ انتخاب شده در پنجره دیتابیس ( سمت چپ که لیست فرم و جداول و ... است ) را تغییر نام می دهد. برای انتخاب شئ می توانید از متد SelectObject استفاده بنمائید با بهره گیری از آرگومان InDataBaseWindow و تنظیم آن به Yes ( True )

If you leave the ObjectType and OldName arguments blank (the default constant, acDefault, is assumed for ObjectType), Access renames the object selected in the Database window. To select an object in the Database window, you can use the SelectObject method with the InDatabaseWindow argument set to Yes (True).


Docmd.SelectObject  ObjectTypeObjectNameInNavigationPane


دو تا آرگومان آخر انتخابی هستند و می توانند خالی بمانند آرگومان آخر برای شی باز است اگر False تنظیم شود. پیش فرض InnavigationPane ( در  پنل راهبری که همان پنجره دیتابیس است ) نیز False است


DoCmd.Rename "Old Employees Table", acTable, "Employees"


Run-time error '7874':
Microsoft Access cant find the object 'Test'
مایکروسافت اکسس نمی تواند آبجکت اشاره شده را پیدا کند
یا تغییر نام دادید یا اصلا جدول یا کوئری یا فرم یا گزارش
در دیتابیس موجود نیستند.


گرفتن مقادیر انتخاب شده در سل ها ی دیتاشیت


با SelTop میشود مشخص کرد که کدام Row در بالاترین  مستطیل انتخابی در جدول ، کوئری ، دیتاشیت یا کانتینوس ف رم وجود دارد ( منظور اگر چند سل را انتخاب کرده باشید شماره ی مستطیل اول را بیان میکند بصورت  Long ) اگر کالمن انتخاب شود پراپرتی مربوطه را نمی توانید تغییر دهید.

درتصویر پائین رکوردها انتخاب شده میتوان با Me.SelHeight  تعداد انتخاب شده ها را گرفت توسط ایونت  MouseUpو ذخیره در متغیر عمومی و بعد برای نمایش مقادیر انتخاب شده

۱-ایجاد رکوردست با RecordSetClone

۲-رفتن به رکورد اول 

۳-تغییر موقعیت در رکوردست با پراپرتی Move که Rows آن SelTop میشود.

۴-ایجاد حلقه از یک تا جائی که به Sel برسد یا ممکنه حتی Sel-1 در این حلقه میتوان از پراپرتی Fields اون رکوردست استفاده کرد تا با MsgBox مقداراون فیلد را برگرداند .  

این روش ها درست است : فرضا اگر FLD1 کالمن اول رکوردست باشد منظور در جدول یا کوئری و از صفر شروع میشود.


("MsgBox RS.FIELDS("FLD1

( MsgBox RS(0

MsgBox RS!FLD1



با استفاده از پراپرتی های  SelHeight و SelWidth فرم هم می توان سایز واقعی مستطیل انتخابی در دیتاشیت را مشخص نمود.

بعبارتی گوشه ی راست پائینی مستطیل انتخابی را تعیین میکند

SelTop و SelLeft هم گوشه ی بالائی چپ مستطیل انتخاب شده میتواند چند مستطیل باشد 


برگشت تعداد رکوردهای متاثر از اکشن کوئری ها


مثل Delete یا Add 


استفاده از   متد Execute نه RunSql  و بعد پراپرتی  RecordsAffected  از CurrentDb



لیست چندی از پراپرتی های اکسس ،   پراپرتی  CurrentDb.Properties 

Name
Connect

Version
RecordsAffected  شمارش رکوردهای تحت تاثیر اکشن کوئری ها فرضا دیلیت یا اپند 
Connection
AccessVersion
StartUpForm در قسمت آپشن و این خصوصیت می توانید فرمی را برای بنمایش درآمدن در هنگام فعال کردن ماکروها اجرا کنید
StartUpShowDBWindow  منظور همان NavigationPane هست 
StartUpShowStatusBar نوار پائینی در آبجکت ها 
AllowShortcutMenus  برداشتن تیک در آپشن قسمت مربوطه یا کارنت دیتابیس یا کلاینت ستینگ باعث میشود که شورت کات هائی که در فرم یا گزارش وجود دارد و با کلیک راست اعمال می گردد غیرفعال شوند.
AllowFullMenus : فعال یا غیرفعال کردن منوهای اکسس منظور تب پیج های ریبون غیر از تب File که قابل حذف یا هاید کردن نیست
AllowBuiltInToolbars : در اکسس ۲۰۰۳ به پائین  کاربرد داشت که ToolBar شما اعمال میشد منظور منوهایی که جای ریبون موجود در ۲۰۰۳ به بالا وجود دارند.
AllowToolbarChanges
AllowSpecialKeys : فعال یا غیرفعال کردن کلید ترکیبی Alt و F11 
AppTitle   عنوان برای اپلیکیشن در TitleBar 
AppIcon  آیکون برای اپلیکیشن که روی تمام آبجکت ها اعمال خواهد شد 


بعضی از این پراپرتی ها با Docmd.SetOption قابل تنظیم است 

مطالعهhttps://docs.microsoft.com/en-us/office/vba/api/access.application.setoption

کار با رکوردست


لینکhttps://docs.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/recordset-object-dao


از شی رکوردست برای دستکاری داده در دیتابیس در سطح رکورد استفاده میشود ( جدول یا کوئری ) 


چند تا تیپ داره یکیش SnapShot هست که ReadOnly است و قابل Edit نیست و بعدی Dynaset که Read و Write را دارد برای باز کردن رکوردست در دیتابیس جاری از متد OpenRecordset از CurrentDb استفاده میشود فرضا میخواهیم جدول یک را در رکوردست باز کنید 

***اول اظهار متغیری بعنوان رکوردست 

Dim Rs As DAO.Recordset ( اگر Object Library تیک نخورده باشد از Refrences ارور میدهد ).

***دوم ایجاد آن در بافر 

(Set Rs=CurrentDb.OpenRecordset("Table1",dbOpenDynaset

-برای دستکاری دیتا در رکورد : برای دیلیت از Rs.Delete  برای اضافه کردن از Rs.Add و برای ویرایش از Rs.Edit استفاده می کنیم و حتما باید بعد از اینها Rs.Update نوشته شود.

-برای رفتن به رکورد اول ، بعدی ، قبلی و آخر به ترتیب از

 MoveLast MovePrevious MoveNext MoveFirst استفاده می کنیم بیشتر برای لوپ زدن داخل رکوردست استفاده میشود.

***سوم  بعد از اتمام کار بستن رکوردست با Rs.Close و خالی کردن بافر از آن با Nothing

Rs.Eof  مقداری رو میده از نوع Boolean که آیا موقعیت رکورد جاری بعد از رکورد آخر هست یا خیر وقتی به آخرین رکورد برود و زمان رفتن به رکورد بعد از آن که چیزی نیست ارورمیدهد که به انتهای رکوردست رسیده  زمان خاتمه به حلقه هم از آن استفاده میشود مثل 

Do While Not Rs.Eof

("Debug.Print Rs.Field("FldName

Rs.MoveNext

Loop


-از Rs.Move برای انتقال پوزیشن رکورد جاری در شی رکوردست استفاده میشود که پارامتر اول آن Rows است 

-از Rs.AbsolutePosition برای گرفتن شماره رکورد در آن شی  رکوردست استفاده می شود.

-از Rs.FindFirst برای پیدا کردن مقدار یا عبارتی در رکوردست استفاد میشود و چک کردنش با پراپرتی بعدی یعنی NoMatch هست مثل 

     برای عدد Rs.FindFirst "FldName1=" & Me.txtValue

 برای تکست "'" & Rs.FindFirst "FldName1='" & Me.txt1


-از Rs.NoMatch برای تطابق داده ی پیدا شده با استفاده از  FindFirst استفاده میشود یعنی اگر توسط FindFirst پیدا شد چه عملی انجام دهد 

"'"  & Rs.FindFirst "FieldName='" & Me.TxtSearch 

If Rs.NoMatch=False Then 

 DO Something  ' 

End If 

- از Rs.RecordCount برای شمارش رکورد در رکوردست باز شده استفاده میکنیم البته اول باید به رکورد آخر برویم و بعد رکورداول و بعد رکوردکانت را استفاده کنیم تا درست عمل نماید.

- از Rs.BookMark بعنوان نشانگری  که به طور یونیک رکورد جاری را در شی رکوردست مشخص میکند استفاده میشود ... فرضا در ورد بعبارت ساده و قابل فهم  ، عباراتی را بعنوان بوک مارک در نظر می گیرید  ، زمان استفاده به آن صفحه ای که هست می رود . اینجا هم همینطور است فرضا در فرم رکوردی را اضافه میکنید و با استفاده از FindFirst و NoMatch و برابر قرار دادن BookMark فرم و BookMark  رکوردست میتوان به همان  رکورد در سابفرم رفت چون دیتای جدید بعد از رکورد آخر می آید 


برای ایجاد RowNumber یا LineNo  در فرم  کانتینیوس نه سینگل هم بوک مارک رکوردست با بوک مارک فرم برابر میشود و از AbsolutePosition باضافه ی یک استفاده میکنیم برای برگشت مقدار تابع فرضا 


(Function ROWNUM(FRM AS FORM

 اگر کارنت رکورد فرم مخالف رکوردکانت رکوردست بود بوک مارک رکوردست برابر بوک مارک فرم شود

ROWNUM=RS.ABSOLUTEPOSITION+1

END IF

END FUNCTION

درنظر داشته باشید شماره ی رکورد در دیتا شیت اکسس با رکوردست یکی نیست !!! 

عملکرد کمبوی مالتیپل فیلد و تیک زدن آیتم ها



در فرم اگر کمبوی مالتیپل داشته باشید طبق معمول برای تیک زدن یا برداشتن تیک به این روش عمل می کنید 


۱-فوکس کردن روی کمبو 

۲-انجام عمل دارپ داون با کلیک کردن روی فلش پائین سمت چپ کمبو که با بازشدن لیست باکس همراه هست و تیک زدن با لفت ماوس فرضا که اگر انتخاب شده باشد برداشه و اگر نشده باشد دوباره انتخاب می شود 


روش کد نویسی 

۱-SetFocus

2-DropDown

لیست باکس آن پراپرتی ListCount دارد.

3-پراپرتی (Selected(index کمبو یا لیست باکس  برای تیک زدن یا برداشتن برابر True یا False


کمبو باکس از قسمت های زیر تشکیل شده : 

ادیت باکس ، دراپ داون و لیست باکس 


 (Me.F.Selected(i)=Not  Me.F.Selected(i

اضافه کردن ثانیه به ساعت


چون اکسس در بعضی سیستم ها ساعت را بصورت AmPm و نه حالت ۲۴ ساعته نشان می دهد بنابراین برای حل مشکل باید ماژولی نوشت که اگر Format اون Time جاری AM شد عدد ۱۲ به آن اضافه بنماید البته برای ساعات خیلی بالاتر باید ارور را رفع کرد بعد تبدیل ساعت و دقیقه به ثانیه و جمع کردن با خود ثانیه 

فرضا اضافه کردن 520 ثانیه  ( 8 دقیقه و 40 ثانیه ) به تایم زیر 


 1:14:20AM

Start ..... 131420

Dim H,M,S

(H=Mid(Start,1,2

(M=Mid(Start,3,2

(S=Mid(Start,5,2

 در اینجا 13 در 3600 و 14 در 60 ضرب شده وبا 20 جمع می گردد و با عدد 520 ثانیه در بالا جمع میشود که عدد 48180 بدست می آید برای تبدیل این عدد به ساعت دقیقه و ثانیه اول 48180 را به 3600 تقسیم می کنیم  که عدد 13 بدست می آید دوم  Remainder ( یا باقیمانده ی تقسیم  )  عدد 48180 بر 3600 را محاسبه می کنیم  وبر 60 تقسیم می کنیم  که عدد 23 میشود ( عدد دقیقه بدست آمد )  و ثانیه هم از Remainder عدد قبلی حاصل میشود یعنی  1380 منهای 22 در 60 : 0 


AMPMhttps://www.languagecentre.ir/english/vocabulary/difference-between-pm-am


ساعت ( 13) دقیقه (23) ثانیه (0)

گرفتن ولیوهای مالتیپل فیلد یا کمبوهای چک باکس دار


برای گرفتن ولیوهای داخل MultipleFieldValue باید از رکوردست ۲ استفاده کرد و پل زدن به آن فیلد و پراپرتی Value آن  فرضا فیلد  Rooz داریم و چند آیتم در آن وارد شده 



۱-باز کردن رکوردست ۱ ( جدول )

۲-تنظیم رکوردست ۲ به فیلد رکوردست ۱ ( Rooz ) و پراپرتی ولیو  (Value)


البته برای لیست شدن کلیه ی تیک خورده ها باید Loop زده شود و استفاده از MoveNext برای رفتن به رکورد بعدی در آن رکوردست 

پرینت داکیومنت یا پیج ها در اکسس


برای پرینت گرفتن ورد پی دی اف یا هر چیزی که قابلیت پرینت داشته باشد از طریق اکسس ارتباط با شل یا سا ختن آن   (Shell.Application)  است و استفاده از کامند ShellExecute که پارامتر اول آن نام و مسیر فایل است و پارامتر چهارم عبارت پرینت و آخری هم ویو است که فرضا VbHide یا VbNormalFocus و غیره است یا شماره ی آن که میشود در  Immidiate Window Ctrl+G  با علامت سوال قبل از آن ،  عدد مربوطه  رو گرفت 


پرینت  اوپن  و ادیت را میتوان اعمال کرد در ShellExecute

ساخت پراپرتی در اکسس


 (Database.CreateProperty method (DAO


پراپرتی هائی که در اکسس ایجاد نشده را میتوان از کالکشن DAO انتخاب و اضافه کرد جز کانکشن و ارورها مثل پراپرتی زیر برای بستن یا باز کردن شیفت True/False ، تا ایجاد نشن عمل نخواهند کرد و ارور هم داده خواهد شد پراپرتی نات فاوند اگر هم ایجاد بشه ارور قبلا ایجادشده را خواهد داد. 

تایپ هم مهمه مثل پراپرتی زیر که Boolean هست ولی چیزهائی که عبارتی به آن ملحق میشه از نوع dbText هست مثل AppTitle


 "Set Prp=CurrentDb.CreateProperty("AllowByPassKey

(dbBoolean,False,False,

CurrentDb.Properties.Append Prp

تبدیل میلادی به قمری


19 جولای سال 622  شروع تاریخ قمری است و مصادف با 27 تیر سال یک شمسی 

Dim D(12) As Long

D(1)=30 : D(2)=59 : D(3)=89 : D(4)=118 : D(5)=148  D(6)=177 : D(7)=207 : D(8)=236 : D(9)=266 : D(10)=295 : D(11)=325 : D(12)=354

یک در میان ماه ها ی قمری را بصورت قراردادی 29 مشخص کرده اند یعنی ماه اول که محرم است 30 روز و ماه بعدی 29  و با این منوال ماه های فرد را 30 روز و ماه های زوج را 29 روزه گرفته اند و در صورت کبیسه بودن سال طبق جدول ، روش رایج در گاه شمار قراردادی ماه آخر بجای 29 روزه 30 روزه در نظر خواهند گرفت.


در رایج‌ترین تقویم هجری قمری حسابی طی یک دوره سی ساله کبیسه منظم از قرار زیر محاسبه شده‌است:
بر اساس این کبیسه‌گیری، چنانچه باقی‌ماندهٔ حاصل تقسیم سال قمری به عدد ۳۰ یکی از اعداد (۲، ۵، ۷، ۱۰، ۱۳، ۱۶، ۱۸، ۲۱، ۲۴، ۲۶ و ۲۹) باشد، سال مذکور کبیسه و طول آن (۳۵۵ روزه) می‌باشد.


با کانتر براحتی میتوان تاریخ دقیق را بدست آورد اگر کبیسه دقیق و طبق جدول، روش رایج  ،که اقتباس شده بدست آید ،  ولی در فواصل طولانی حدودا ۳ ثانیه بازگشت بطول خواهد انجامید پس باید دنبال راهی باشید که کمترین زمان برگشتی را داشته باشد.


18 ژانویه سال 624 معادل 27 دی سال 2 ، اختلاف با تابع DateDiff اکسس بین  19 جولای 622 که شروع قمری است  تا تاریخ 18 ژانویه ی 624 موردتبدیل ما 549 روز است  که یک واحد به آن اضافه می کنیم .


در اینجا 550  از 354 بزرگتر است پس  D12 را از آن کم میکنیم میشود 195 و سال هم  بالطبع یک واحد بدان اضافه شده و 2 خواهد شد  ،  طبق آرایه ی بالا 195 بین D6 و D7 است پس کوچکتر از عدد 195 را انتخاب میکنیم  177-195 که میشود 18 ( روز )   و  عدد آرایه ی  177  6 است که آنرا باضافه ی یک می کنیم که ماه عدد 7 می شود


بنابراین سال شد 2 ماه  7 و روز هم 18 


2/4/14  -  6 جولای 623  و  28 ذی الحجه سال  ۱ قمری ، 352

2/4/15  -  7 جولای 623  و  29 ذی الحجه سال  ۱ قمری ، 353

2/4/16  -  8 جولای 623  و  1 محرم سال  2 قمری ، 354

2/4/17  -  9 جولای 623  و  2 محرم سال 2 قمری ، 355



۱۲ تیر سال ۵ شمسی معادل ۴ جولای ۶۲۶ و ۳۰ محرم (۱) سال ۵ ... اختلاف ۱۴۴۶ روز 

۷ تیر سال ۵ شمسی معادل ۲۹ جون ۶۲۶ و ۲۵ محرم (۱) سال ۵ ... اختلاف ۱۴۴۱


۲۷ تیر سال یک شمسی آغار سال قمری و ۱۹ جولای ۶۲۲ آغاز سال قمری اختلاف ها با DateDiff

                                     

1446=("Dif=DateDiff("n","7/19/622","7/4/626

Ret=Dif=1446+1=1447

 ( If 1447>354 (True

Y=2 Ret=1447-354=1093

 ( If 1093>354 (True

2=Kabiseh Y=3 Ret=1093-355=738

( If 738>354 (True

3=NoKabiseh Y=4 Ret=738-354=384

( If 384>354 (True

4=Nokabiseh Y=5 Ret=384-354=30

(If 30>354 (False

(If Ret=D(1) , M=۰ : Ret=D(1

If Ret<D(1) , M=۰ : Ret=D(1)-Ret

 ...   If

  ...   If

M=M+1

تا زمانی لوپ ادامه می یابد که Ret کوچکتر مساوی (D(M شود

Ret=30 , M=1

Year : 5  , M : 1 , D : 30 

۳۰ محرم سال ۵

تبدیل میلادی به قمری

باحسابhttps://www.bahesab.ir/time/conversion/


لینک بالا ۱۴۳۶ تا ۱۴۳۸ را کبیسه ی قمری نشان میدهد در حالیکه در تقویم های آنلاین دیگر ۱۴۳۶ کبیسه ولی ۱۴۳۷ کبیسه نیست  ؟؟!!!! ولی ما بر حسب همان رایج استفاده می کنیم که قابل اعتمادتر است . انشالله باحساب توضیح قانع کننده برای کبیسه بودن ۳ سال پشت سر هم در سایتش داشته باشد ..( ۲۰ رمضان )






دست نویس تبدیل میلادی به شمسی در فواصل زیاد

اختلاف بین ۱/۱/۱ تا ۱/۱۲/۲۹ عدد ۳۶۴ است که در اینجا عدد ثابتیست 

عدد ۳۲۹ و ۳۱۵  کبیسه های از سال ۶۲۲ تا ۱۹۷۷ و ۱۹۲۰ هستند باید حتما با ۳۶۵ جمع شوند 


این دست نویس ها ارزشمند هستند در صورت صفر شدن باید تغییر رویه داد 


روزهای سپری شده از اول سال شمسی تا تاریخ موردنظر

مثال های زیر در ایجاد تقویم شمسی کمک خواهند کرد فقط با محاسبه ی روزهای سپری شده از جمعه ۱/۱/۱ 


از جمعه ۱/۱/۱  تا دوشنبه ۱۳۹۸/۲/۳۰   میشود ۵۱۰۳۰۳


510303 mod 7 = 3    

اگر مانده ی تقسیم صفرشد یعنی جمعه هست ... ۳ یعنی دوشنبه 

۱۳۷۸/۱۰/۱۱    :  ۵۰۳۲۲۴  

معادل شنبه یک ژانویه ی ۲۰۰۰

503224 mod 7 = 1

یک یعنی شنبه


۱۳۷۹/۱۰/۱۲ : ۵۰۳۵۹۰     

معادل دوشنبه ۱ ژانویه ۲۰۰۱

۵۰۳۵۹۰ mod ۷ = ۳

۳ یعنی دوشنبه


۱۳۵۷/۶/۲۰ : ۴۹۵۴۴۲

معادل  دوشنبه ۱۱ سپتامبر ۱۹۷۸ 

۴۹۵۴۴۲ mod ۷ = ۳

۳ یعنی دوشنبه


۱۲۹۸/۱۰/۱۰ : ۴۷۴۰۰۴

معادل پنج شنبه ۱ ژانویه ۱۹۲۰

۴۷۴۰۰۴ mod ۷ = ۶ 

۶ یعنی پنج شنبه


۱۳۹۸/۱/۱ : ۵۱۰۲۴۳

معادل پنج شنبه ۲۱ مارس ۲۰۱۹

۵۱۰۲۴۳ mod ۷ = ۶ 

۶ یعنی پنج شنبه


لینک محاسبه گر روز و اختلافhttps://www.bahesab.ir/time/age/ 


لینک مانده ی تقسیمhttps://www.omnicalculator.com/math/modulo  

WndProc



 :  WndProc

case WM_INITDIALOG

ShowWindow GetDlgItem(hDlg,IDOK),SW_HIDE

hBitmap1=CreateWindowEx(WS_EX_TRANSPARENT,"Button","Login", WS_VISIBLE Or WS_CHILD Or BS_BITMAP,60, 150,100, 25,hDlg,(HMENU)IDC_BUTTON2, NULL, NULL

(

(hdc = GetDC(hDlg

  (hMemDC = CreateCompatibleDC(hdc

(hBitmap = CreateCompatibleBitmap(hdc,120,25

  SelectObject hMemDC,hBitmap 

(SetDCBrushColor hMemDC,RGB(212,208,20

Dim r As RECT

r.left = 0
  r.right = 120
  r.top = 0
  r.bottom = 25

  (FillRect(hMemDC,r,GetStockObject(DC_BRUSH

  DeleteDC hMemDC

  ReleaseDC hDlg,hdc