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

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

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

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

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

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



در فرم یک در بالای فرم در نمای دیزاین ۳ لیبل طراحی شده  از M0 تا M2 بعنوان منو ، هفت لیبل دیگر بطور زیرهم بعنوان ساب از S0 تا S7 ایجاد شده و کنار آنها دوباره هفت لیبل دیگر بعنوان ساب ساب از SS0 تا SS7 قرارداده شده ، در انتهای لیبل های بعنوان ساب  ( S0 تا S7 ) دوباره 7 لیبل از Z0 تاZ7 ایجاد شده برای قرار دادن فلشها در کپشن آنها پس جمعا    ( 1X3+3X7 )


ترتیب فیلدها ازراست به چپ است اینجا برعکس افتاده 

Mnu
MnuTitle
M0ایران
M1اکسس
M2پروفسور




در فیلد Type زمانیکه DropDown مشخص شود زمان فشرده شدن هر کدام از لیبل هایی که زیر لیبل های بالایی قرار می گیرند  در تابع SubClk گفته شده اگر این کلمه بود ( با تابع DlookUp ) ، لیبل های دیگری که بعنوان SS درنظر گرفته شده در زیر آن لیبل ساب قرار گیرند و اگر فیلد Type خالی بود لیبل های با پیشوند SS که از 0 تا 7 است در کنار آن لیبل های ساب و کمی پایین تر با استفاده از پراپرتی Visible مشاهده خواهند شد.

Sub
Mnu Sub Title Type
M0 S0 Access
M1 S0 VBA
M1 S1 Menu
M2 S0 AccessVba
M2 S1 .
M2 S2 BlogSky DropDown
M2 S3 .
M2 S4 Com




SubSub
Mnu Sub SubSub Title
M0 S0 SS0 MNU0SUB0SUB0
M0 S0 SS1 MNU0SUB0SUB1
M0 S0 SS2 MNU0SUB0SUB2
M0 S0 SS3 MNU0SUB0SUB3
M0 S0 SS4 MNU0SUB0SUB4
M1 S1 SS0 MNU1SUB1SUB0
M1 S1 SS1 MNU1SUB1SUB1
M2 S0 SS0 MNU2SUB0SUB0
M2 S0 SS1 MNU2SUB0SUB1
M2 S0 SS2 MNU2SUB0SUB2
M2 S0 SS3 MNU2SUB0SUB3
M2 S0 SS4 MNU2SUB0SUB4
M2 S0 SS5 MNU2SUB0SUB5
M2 S0 SS6 MNU2SUB0SUB6
M2 S1 SS0 MNU2SUB1SUB0
M2 S2 SS0 MNU2SUB2SUB0
M2 S2 SS1 MNU2SUB2SUB1
M2 S3 SS0 MNU2SUB3SUB0
M2 S3 SS1 MNU2SUB3SUB1
M2 S3 SS2 MNU2SUB3SUB2
M2 S3 SS3 MNU2SUB3SUB3


استفاده از یونیکد برای فلش ها : 

(Chrw(9658

(Chrw(9650

(Chrw(9660


از دوتابع   MnuClk و SubClk استفاده شده که تابع اول برای زمانیست که روی لیبل های بالایی ( بعنوان منو ) رویداد کلیک باصطلاح فایر شود و لیبل های پایینی مشاهده شوند یا نشوند ( ذخیره 1 در پراپرتی Tag کنترل منو زمانیکه که لیبل فشرده شد   ) و دومی برای انجام رویداد کلیک لیبل هایی که در پایین  لیبل های بالایی قرار می گیرند ، برای تغییر رنگ لیبل های ساب هم  از تابع SubMouseMove استفاده شده.



شرح تابع SubClk ، تابعی که زمان فشرده شدن یکی از هفت لیبل های بانام S0 تا S7 باید وظیفه ای را انجام دهد یا باز کردن فرم و گزارش خاصی و یا هر عمل دیگری و یا خودش زیر منوهایی در دل خودش داردکه باید در زیر یا کنار آن Visible شوند : 


نکته : زمان فشرده شدن لیبل های بالایی ( M0 تا M2 ) باید نام لیبل فشرده شده ( تابع MnuClk ) را در متغیری ذخیره کرد چرا ؟ بخاطر اینکه باید در عبارت پایینی که توضیح داده شده استفاده کرد ( یعنی باید در جدول Sub و منوی فشرده شده طبق فیلد Mnu پیدا کند که فیلد Type حاوی رشته ی DropDown است یا خیر!!! )


در شروع تابع می بایست در نظر گرفت اگر سابی فشرده شد که طبق منوی فشرده شده در فیلد Type آن DropDown بود به چه نحو عمل شود که زمان لوپ زدن در SS0 تا SS7  بفهمانیم باید لیبل های ساب زیر ساب فشرده شده به پائین تر منتقل شده تا لیبل های SS0 تا SS7 جای خالی آنها قرار گیرند برای اینکار از تابع DlookUp استفاده می کنیم 


PP متغیریست که عدد انتهای لیبل ساب فشرده شده ( با پیشوند S  ) را در خود ذخیره میکند و در پائین بردن لیبل های ساب بعد از لیبل ساب فشرده شده بما کمک خواهد کرد.


("","PP=Replace(C.Name,"S

تابع زیرطبق گفته بالا چک میکند که فیلد Type در جدول Sub طبق منوی فشرده شده و برابر بودنش با فیلد Mnu معادل DropDown است یا Null  متغیر Mn در اول رویه تعریف شده و در تابع MnuClk مقدار میگیرد چون برای LookUp به نام منو نیاز داریم 

"  if DlookUp("Type","Sub","Mnu='" & Mn  & "'")="DropDown Then

متغیر Drop نوع Boolean یا میتواند عددی باشد Integer 

Drop=True

End If


در بعد از لوپ می بایست در یک متغیر لیبل فشرده شده را ذخیره کرد و در قبل از لوپ نوشت تا درصورتیکه لیبل فشرده شده   مخالف مقدار آن متغیر بود Z برابر یک شود 


 در اینجا می توانید از دو متغیر SubCount و SubSubCount استفاده کنید


( "'" & SubCount=Dcount("Sub","Sub","Mnu='" & C.Name


 از SubSubCount برای شمارش تعداد لیبل هایی  ( SS0 تا SS 7 طبق جدول SubSub و لیبلی  که [ بعنوان منو ]  کلیک   و در Mn ذخیره شده ) که باید ویزیبل شوند استفاده میشود حال نحوه ی استفاده چطور است ؟ 


توضیح : 


در لوپی که در SS ها زده میشود (  با استفاده از For ... Next ) از 0 تا 7  باید گفته شود اگر Drop برابر Yes شود  لیبل های سابی که بزرگتر از کنترل ساب فشرده شده بود به بعد از تعداد SubSub های شمرده شده در جدول SubSub برود بطور مثال اگر منوی 2 پنج Sub ( شروع از S0 تا S4 )  داشت زمان فشرده شدن لیبل با نام  S2 ( از منوی با نام M2 ) بقیه ی آنها یعنی S3 و S4 به تعداد کانت  فیلد SubSub در همین جدول پائین برود باضافه ی ارتفاع کنترل فشرده شده .  درضمن باید بفکر این هم باشید که اگر همان کنترل S2 که عمل کرده دوباره فشرده شود کنترل های S3 و S4 به همان موقعیت قبل برگردد و پراپرتی Visible کنترل ها ی SS0 تا SS7 نیز برابر صفر شود ،  پس باید متغیری نوشت از نوع Static یا در Tempvars ذخیره کرد


در اینجا باید DlookUp بنویسید که پراپرتی ویزیبل SS ها طبق جدول SubSub مخالف عددی غیر از صفر شوند تا قابل مشاهده شوند 


If Drop=Yes Then 

باید روی  لیبل های بعد از لیبل فشرده شده اعمال شود بخاطر همین باضافه یک کردیم 

PP=PP+1 

اگر لیبل فشرده شده ( در اینجا فرضا عدد PP دو است و باضافه ی یک شده ) کمتر از SubCount که 5 است شد و برای یکبار هم فشرده شد (""= Z)  پراپرتی Top کنترل 3 میشود مقدار پراپرتی Top کنترل 3 باضافه ارتفاع کنترل فشرده شده در تعداد SS ها که در زیر S2 باید قرار گیرند 


if PP<SubCount And  Z=1 Then 

Controls("S" & PP).Top=Controls("S" & PP).Top+c.Height*SubSubCount


حال در اینجا باید ذکر کرد طبق If بالا Z=1 شد یعنی لیبل S2 دوباره فشرده شد لیبل های S3 و S4 به موقعیت اول برگردند فرضا از پراپرتی Tag این لیبل ها استفاده کنید و در تابع MnuClk در لوپ زده شده اعلام کنید که Tag کل لیبل های S بشود مقدار پراپرتی Top آنها. در ضمن پراپرتی ویزیبل لیبل با پیشوند SS باید صفر شود.


End If 

و در اینجا لفت ها را تعیین میکنید


در غیر اینصورت اگر Drop برابر Yes نبود مقدار Top و Left لیبل های SS تنطیم میشود که در پهلوی لیبل S  دار قرار گیرند 



پیشوند لیبل منو M

پیشوند لیبل ساب که در زیر لیبل منو قرار میگیرد S

پیشوند لیبل سابی که در کنارلیبل ساب یا زیر آن قرار می گیرد SS

پیشوند لیبلی که در کپشن آن فلش های بالا پایین و راست  قرار می گیرد Z





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


دو جدول ساخته شد یکی شامل دو فیلد Mnu و Title برای رکورد کردن  نامگذاری منوها و عنوان آنها ، در شکل زیر لیبل از سمت راست به چپ با نام های M0 تا M2  می باشند.



جدول Sub با فیلدهای Mnu ، Sub ، Title که نام های منو  ساب منو و عنوان ساب منو در آن رکورد میشوند، نامگذاری لیبل های زیر منو طبق تصویر از S0 تا S7 است.




دستور کار : 

1-تعریف متغیر M در بالاترین رویه برای ذخیره کنترل فشرده شده 

2-تعریف متغیر MnuBkColor در بالاترین رویه برای ذخیره کردن BackColor کنترل لیبل منو که  System Menu Bar تنظیم شده 

3-زمان لود شدن فرم مقدار متغیر MnuBkColor برابر با پراپرتی BackColor یکی از لیبل ها شود فرضا   M0.BackColor

در هرکدام از رویدادهای کلیک لیبل های شکل یک بعنوان منو یک تابع نوشته شده به ترتیب زیر :

 

1-در تابع اگر کنترل فشرده شده مخالف M  و M نال نبود سپس  پراپرتی BackColor مقداری که در M ذخیره شده بشود  

2-تنظیم پراپرتی BackColor کنترل فشرده شده به (RGB(160,200,160

3-برابر کردن M با کنترل فشرده شده 

4-بخاطر اینکه زمان فشرده شده روی منو اگر قبلا فشرده نشده پراپرتی Tag آن تغییر یابد ( برای نمایش یا ویزیبل شدن sub ها و یا ویزیبل نشدنشان ) نوشت  اگر پراپرتی Tag کنترل فشرده شده برابر "" شود به 1 تغییریابد در غیر اینصورت دوباره Tag یک شود

5-لوپ در کنترل های Sub با For.....Next از 0 تا 7 مثل    For i=0 To 7

6-در اینجا مقادیر پراپرتی Tag کنترل فشرده شد ( منو ) کاربرد دارد که اگر یک باشدمی بایست لیبل های Sub   طبق جدول  نامشان ویزیبل شوند وبقیه که در لود فرم نوشتیم کلا Visible=No همان No باشند 

_  & " Me.Controls("s" & i).Visible = IIf(DLookup("Sub", "Sub", "mnu='" & c.Name & "' and

(Sub='" & Controls("s" & i).Name & "'") <> "", True, False"

 _&  " Me.Controls("s" & i).Caption = Nz(DLookup("Title", "Sub", "mnu='" & c.Name & "' and

"'" &  Sub="'" & Controls("s" & i).Name

Me.Controls("s" & i).Left = c.Left

(Me.Controls("s" & i).BackColor = RGB(160, 200, 160

در غیر اینصورت پراپرتی Visible کل لیبل های Sub به No تنظیم شوند که هاید شوند و پراپرتی BackColor کنترل فشرده شده ( منو ) نیز به MnuBkColor تنظیم شود 

کالر لیبل های سابی ( منظور لیبل های عمودی ) که به آبی تغییر پیدا می کنند از رویداد MouseMove آنها استفاده شده و در اینجا هم نیاز به ذخیره کردن نام ساب در یک متغیر است برای مقایسه کردن و تغییر رنگ به جدید و برگرداندن به رنگ قبلی 


دور لیبل های بالا بعنوان منو با کنترل لاین که در نوار Design فرم است  کشیده شده 










CommandButton.BottomPadding property (Access) در ساخت باتن های آبشاری


تماما با اشراف نسبی بر داکیومنت سایت Office شامل آبجکتها و پراپرتی های   مخصوص به کنترل باتن در اکسس و با راهنمایی متخصصین فروم های خارجی تهیه و در دسترس عموم گذاشته شد تا فراگیران با تسلط به مبانی گفته شده بتوانند ماژولی برای دستیابی بهتر از این اثر خلق نمایند .


یادرآوری میشود کنترل باتن و غیره در نمای دیزاین قابل ساخت است اگر کسی فایل را بصورت کامپایل شده ارائه دهد ( accde ) اگر ماژولی نوشته باشد که اتومات کنترلی را به فرم اضافه نماید بعلت اینکه در این حالت نمای دیزاین بسته میشه فقط خود را ضایع ساخته 


جدول مربوطه :



فرم2 که فرم اصلیست و حاوی باتن های 0 تا 3 است و Stacked شده :




فرم 3 حاوی باتن های 0 تا 15 که به داخل فرم 2 کشیده شده و یکسری از پراپرتیهای آن فرم دستی تنطیم شده :




در وهله ی اول نوشتن تابعی و قرار دادن آن داخل رویداد کلیک هر یک از باتن های فرم 2 


( Function SetSubButtons(c As Control 

نوشتن لوپ برای صفر کردن پراپرتی BottomPadding  باتن های فرم 2 اگر صفر نشوند معادلات شما بهم خواهد ریخت تست کنید

For i=0 to 3

Controls("Command" & i).BottomPadding = 0

Next

گرفتن آخرین مقدار Sub وارد شده در جدول طبق باتن فشرده شده در فرم 2

"'"  &  d = DLast("Sub", "Table1", "Main='" & c.Name 

باز شدن فرم 3 که سابفرمیست در فرم 2 تا مقدار d که در بالا گرفته شد 

Me.Form3.Height=Me.Form3.Controls("" & d & "").Top + Me.Form3.Controls("" & d & "").Height - 5

پراپرتی Left سابفرم 3 را معادل Left باتن فشرده شده در فرم 2 قرار میدهیم 

Me.Form3.Left = c.Left

پراپرتی Top سابفرم 3 را تنظیم میکنیم تا سابفرم در زیر باتن فشرده شده در فرم 2 قرار گیرد

Me.Form3.Top = c.Top + c.Height + c.TopPadding


End Function


نکته : 


در تابع باید قبل از لوپ نوشته شود که در صورتیکه BottomPadding  کنترل فشرده شده مخالف صفر بود و همچنین ارتفاع سابفرم 3 مخالف صفر بود c.BottomPadding و Me.Form3.Height صفر شود در غیر اینصورت بعد از Next  انجام شود 

(Public Function SetSubButtonS(c As Control

If c.BottomPadding<>0 And Me.Form3.Height<>0 Then 

c.BottomPadding=0: Me.form3.Height=0

Esle

For

.

.

Next

.

.

End if

End Fucntion



شکل زیر بیانگر تست شدن موارد بالاست البته چند مورد سلیقه ایست مثل باز شدن آبشاری زیر باتن های اصلی یا بسته شدن سابفرم 3 که با Pause انجام شده 



برای باز شدن آبشاری باید از تابع Pause که در سایت ها گذاشته شده و از Timer ،  حلقه و Doevents  استفاده می کند بهره ببرید  

برای اینکار نیازمند نوشتن لوپ دیگر در انتهای تابع بالا دارید بطوریکه یک سوم یک سوم به ارتفاع سابفرم 3 و همچنین پراپرتی BottomPadding کنترل فشرده شده اضافه شود ... برای کاهش زماینکه که سابفرم 3 باز است و روی همان کنترل کلیک می کنید می بایست در If بالا لوپی تعبیه گردد تا یک سوم یک سوم کاهش پیدا کند و احتیاجی به صفر کردن پراپرتی BottomPadding نیست .


 زمانیکه ماوس از روی کنترل های فرم 2  جای دیگری منتقل می شود چنانچه سابفرم 3 اتفاع داشته باشد و BottomPadding مخالف صفر باشد کل باتن ها BottomPadding خود را از دست داده و پراپرتی  ارتفاع سابفرم 3 نیز به صفر تنظیم میشود ( از رویداد MouseMove در سکشن Detail  که باتن های فرم  2 در آن قرار دارند استفاده شده )


طبق جدول کامندهای Sub ( فرم ۳ ) به ترتیب از صفر به بعد نوشته شده و در هیچکدام از قلم افتادگی وجود ندارد به این نکته نیز توجه داشته باشید !!!








DropDown MenuBar



نمایش منوبار بعد از کلیک کردن روی باتن در همان مختصات بعد از ساختن CommandBar از مجموعه ی DLL های  متصل به اکسس ، ولی قابلیت چپ چین شدن رو ندارند بنابراین در پروژه های فارسی کاربردی ندارند.


Public objPopup As Object
Private Sub Command13_Click()
    Set objPopup = CommandBars("Menu Bar")
    objPopup.ShowPopup
    Set objPopup = Nothing
End Sub



ساخت باتن کشویی


بسیار ساده ولی پر دردسر 


      Btn0        Bt t1

Btn1        Btnt2

Btn2       Btnt3

Btnt4                   



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


 Function Btn(Bt As Control3) As Doble

For i=1 to 4

Controls("Btnt" & i).Left=Bt.Left+300

 موقعیت پراپرتی TOP هر یک از کنترل های سمت راست میشود ( فرضا Btnt1 میشود Btn0.Top به اضافه ی عرضش و Btnt2 میشود Btn0.Top + Btn.Height +Btnt2.Height

Controls("Btnt" & i).Top=Bt.Top+Bt.Height+(i-1)*Controls("Btnt" & i).Height

(Btn=Controls("Btnt4".Top

Next


یا بصورت زیر 


Function Btn(Bt As Control) As Double

b = Bt.Top

For i = 1 To 4

Controls("Btnt" & i).Left = Btn0.Left+300

Controls("Btnt" & i).Top = b + Controls("Btnt" & i).Height * i

Btn = Controls("Btnt" & i).Top

Next

End Function


چنانچه هر یک Toppadding خودش را داشته باشه فرضا بین باتن های سمت راست هر کدام فواصل متغیری باشد باید آنها را هم در نظر بگیرید ولی معمولا باتن ها را بهم بچسبانید تا نیاز به کد نویسی اضافه تری نباشد.


در رویداد کلیک Btn0 میتوان نوشت که اولا Btnt ها زیر آن بیاید و Btn1 و Btn2 در زیر Btnt ها قرار گیرد 


()Private Sub Btn0_Click

Btn1.Top = Btn(Btn0) + Btnt4.Height

Btn2.Top = Btn1.Top + Btn1.Height

End Sub


()Private Sub Btn1_Click

Btn1.Top=Btn0.Top+Btn0.Height

(Btn2.Top=Btn(Btn1

End Sub 


()Private Sub Btn2_Click

Btn1.Top = Btn0.Top + Btn0.Height

Btn2.Top=Btn1.Top+Btn0.Height

(Call Btn(Btn2

End Sub



تست شده طبق فایل GIF زیر ، نام ها در کپشن باتن ها نوشته شد تا گیج کننده نباشد.  

















تابع RND










SELECT TOP 10 Rnd(Len([strLastName])) AS Expr1,strLastName
FROM tblEmployees
ORDER BY Rnd(Len([strLastName])) DESC;






Logical Operator

:Table

Orders
OrderID Payment Type Ship State/Province
1 Check IL
2 Check NY
3 Credit Card NY
4 Credit CardCredit IL
5 Check IL


:Query


Qr_Orders
OrderID Payment Type Ship State/Province expr1
1 Check IL -1
2 Check NY -1
3 Credit Card NY 0
4 Credit Card IL 0
5 Check IL -1

expr1: ([orders]![payment type]="check" And [orders]![ship state/province]="ny") Or ([orders]![ship

(" state/province]="il" And Not [orders]![payment type]="credit card


طبق کوئری بالا و عبارت Expr1  رکورد یک :  چون در اینجا بهم ریختگی هنگام نمابش وجود دارد جای نقطه پرانتز بگذارید 


(pay="Check" (True ) And State="ny" (False) Or ..... State="il" (True)  And Not Pay="Credit Card (True

.True And False.   Or .True And True.

False Or True 

True =-1


طبق کوئری بالا و عبارت Expr1  رکورد سه :



(pay="Check" (False ) And State="ny" (True) Or ..... State="il" (False)  And Not Pay="Credit Card (False

.False And True. Or .False And False.

False Or False 

Flase=0


طبق کوئری بالا و عبارت Expr1  رکورد چهار :



(pay="Check" (False ) And State="ny" (False) Or ..... State="il" (True)  And Not Pay="Credit Card (False

.False And False. Or .True And False.

False Or False 

Flase=0





:Query

Qr_Orders
OrderID Payment Type Ship State/Province expr1
1 Check IL -1
2 Check NY -1
4 Credit CardCredit IL -1
5 Check IL -1



مثال دوم  :


:Query

Copy Of Qr_Orders
OrderID Payment Type Ship State/Province expr1
1 Check IL -1
2 Check NY -1
3 Credit Card NY 0
4 Credit Card IL 0
5 Check IL -1
6 Check NX 0
7 Check NZ 0
8 Check IL -1


expr1: ([orders]![payment type]="check") And ([orders]![ship state/province]="ny" Or [orders]![ship

(" state/province]="il




طبق Expr1 در گرید بالا : 

رکورد یک


 (Pay="Check" (True) .... And  State="ny" (False) Or State="il" (True 

.True And .False Or True 

True And True

True=-1

رکورد دو


 (Pay="Check" (True) .... And  State="ny" (True) Or State="il" (False 

.True And .True Or False 

True And True

True=-1

رکورد 6 


 (Pay="Check" (True) .... And  State="ny" (False) Or State="il" (False 

.True And .False Or False 

True And False

False=0



:Query


Copy Of Qr_Orders
OrderID Payment Type Ship State/Province expr1
1 Check IL 0
2 Check NY -1
3 Credit Card NY -1
4 Credit Card IL 0
5 Check IL 0
6 Check NX 0
7 Check NZ 0
8 Check IL 0


expr1: ([orders]![payment type]="check" Or [orders]![payment type]="credit card") And [orders]![ship

("state/province]="ny


رکورد اول 

pay="check" True Or Pay="Credit Card" False.... And State="ny" False

True Or False. And False.

True And False

False=0

رکورد دوم 



pay="check" True Or Pay="Credit Card" False.... And State="ny" True

True Or False. And True.

True And True

True=-1



Copy Of Qr_Orders
OrderID Payment Type Ship State/Province expr1
2 Check NY -1
3 Credit Card NY -1







Filter With CheckBoxes


وقتی تکست 1 با لیبل  "کد از " و تکست 3 با لیبل "کد تا "  نال باشد 


[Between [forms]![Form2]![Text1] And [forms]![Form2]![Text3?

Null

([isnull([forms]![Form2]![Text1?

True

[isnull([forms]![Form2]![Text3)?

True

( null or ( True or true?

True


جواب آخر True شد پس کل داده ها در دیتیل کانتینیوس فرم نمایش داده میشود 


به تکست 1 داده 100 که در جدول از نوع نامبر است داده میشود خروجی به ترتیب زیر است 


[forms]![Form2]![Text1]?

100

[forms]![Form2]![Text3]?

Null

[Between [forms]![Form2]![Text1] And [forms]![Form2]![Text3

Null

([isnull([forms]![Form2]![Text1?

False

([isnull([forms]![Form2]![Text3?

True

( null or ( False or true?

True


اگر در تکست 1 عدد 100 و در تکست 3 عدد 103 وارد شود 


[forms]![Form2]![Text1]?

100

[forms]![Form2]![Text3]?

103

[Between [forms]![Form2]![Text1] And [forms]![Form2]![Text3

100 

([isnull([forms]![Form2]![Text1?

False

([isnull([forms]![Form2]![Text3)?

False

False or False?

False

false Or 100?

 100 

منظور اعداد بین 100 تا 103 را در دیتیل کانتینیوس فرم نشان می دهد 
















Event OnChange For TextBox



The Change event occurs when the contents of the specified control change


زمانی اتفاق می افتد که محتویات کنترل مشخص شده تغییر یابد 


فرضا فرمی دارید و یکسری داده ها را از جدول به کنترل ایجادشده  واکشی کرده اید ( یعنی کنترل ها Bound شده هستند )  و داده ها بصورت Continous در گرید بنمایش گذاشته میشود ( در سکشن Detail ) حال در Form Header تکست باکسی  تعبیه کرده اید با نام text5 که Unbound است  . در کویری بیلدر فرم که میتوانید در RecordSource در پراپرتی شیت در نمای دیزاین بدان دست یابید در قسمت فیلد نام و نام خانوادگی در Criteria نوشته اید "*"  & Forms!Form1!text5  ( تکست ۵ در فرم هدر ساخته شده ) برای اینکه همزمان با تایپ کاراکتر در تکست ۵ منبع فرم ریکوئری شود در رویداد Change آن تکست باکس می نویسید 


Me.Requery 


اگر به همین بسنده کنید بعد از تایپ حرف منبع ریکوئری شده با توجه به شرطی که در کوئری قرار داده شده و فوکس به اولین کنترل در دیتیل انتقال داده می شود . در نتیجه باید فوکس را دوباره به text5 منتقل کنیم در نتیجه 


Me.text5.SetFocus 


چانچه عبارت زیر نوشته نشود حروف تاپ شده در همان Space اول درجا میزند یعنی حرف بعدی جایگزین حرف قبلی میشود و باصطلاح به Space بعدی منتقل نمیشود.


(Me.text5.SelStart=Len(Me.text5.text


توضیح در مورد پراپرتی SelStart


عدد صحیح محدوده 0 تا مجموع کاراکترها  در ناحیه تکست باکس کمبو باکس ( چون کمبو یک تکست باکس دارد و یک دراپ داون کنترل )


برای تنظیم یا برگشت این پراپرتی به یک کنترل ، کنترل باید فوکس داشته باشد . برای انتقال فوکی به یک کنترل متد SetFocud را بکار می برند 


اگر  SetFocus داده نشود اروری دریافت خواهید کرد که نبود آنرا متذکر خواهد شد طبق شکل زیر 


You cannot reference a property or method for a control unless the control has the focus


بخصوص در فیلتر در کمبو باکس اتفاق می افتد 




البته در این مورد چنانچه داده ها در دیتیل فرم باشند و نه در سابفرم زمانیکه تایپ می کنید Space Bar نمی گیرد (  یعنی Space بزنید ) و این مشکل بزرگیست . که معمولا با اضافه کردن KeyCode 32 و قرار دادن یک مقدار Boolean در رویداد Keycode دار و اعمال آن در رویداد Change تکست باکس برطرف میشود که اگر مقدار Boolean درست بود میشود 


 " " & Me.text5=Me.text5


در هر صورت کار درستی نیست و همان بهتر که باتنی در فرم ایجاد شود و فیلتر از طریق آن اعمال گردد و یا داده ها در سابفرم آورده شود و سابفرم در دیتیل فرم کشیده شود که این مشکل زدن Space هم در رویداد Change آن تکست باکس حل شود 



در مورد پراپرتی Text در تکست باکس : 


از این پراپرتی می توان برای تنظیم یا بازگشت مقدار موجود در TextBox استفاده نمود



 در حالیکه کنترل فوکس دارد این پراپرتی محتوی داده تکست جاری در کنترل است .پراپرتی Value محتوی آخرین داده ذخیره شده است . وقتی فوکس به کنترل دیگری منتقل میشود داده ی کنترل آپدیت میشود و پراپرتی Value به این داده جدید اختصاص می یابد. تنظیم پراپرتی Text از دسترس خارج است تا زمانیکه دوباره آن کنترل فوکس بگیرد.اگر از کامند Save Record استفاده شود بدون انتقال فوکس پراپرتی Text و پراپرتی Value همچنان یکسان می مانند.



!  Note

To set or return a control's Text property, the control must have the focus, or an error occurs. To move the focus to a control, you can use the SetFocus method or GoToControl action.


طبق نوت آفیس برای استفاده از پراپرتی Text کنترل باید فوکس داشته باشد یا اینکه ارور اتفاق می افتد برای انتقال فوکس از متد SetFocus یا اکشن GoToControl استفاده میشود .









RowCounter



Public Function RowCounter(ByVal strKey As String,ByVal booReset As Boolean,Optional ByVal strGroupKey As String) As Long

Static col  As New Collection
Static strGroup As String
  On Error GoTo Err_RowCounter
If booReset=True Or strGroup <> strGroupKey Then
    Set col = Nothing
    strGroup = strGroupKey
  Else
    col.Add col.Count + 1, strKey
  End If
  
  (RowCounter = col(strKey

End Function 

Details



Set oFolder = CreateObject("Shell.Application").Namespace(Path)
    
    For I = 1 To 100
        Debug.Print I & ": " & oFolder.GetDetailsOf(oFolder.Items.Item(File), I)
    Next I

فیلتر کوئری بر اساس تایپ داده در تکست باکس


Filter a query based on data entered in a text box


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





نمونه ماکرو 







OpenTextFile Method



باز کردن تکست فایل و استفاده از قابلیت های خواندن نوشتن و اضافه کردن در آن 


,object.OpenTextFile (filename,iomode,create

  format


:iomode argument
ForReading=1
ForWriting=2
Open a file and write to the end of the 'file. You can't'

 read from this file '

ForAppending=8


:format argument
TristateUseDefault=-2 'System default
TristateTrue=-1 'Opens the file as Unicoe
TristateFalse=0 'Opens the file as ASCII



Sub OpenTextFileTest Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim fs, f Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.OpenTextFile("c:\testfile.txt", ForAppending, TristateFalse) f.Write "Hello world!" f.Close End Sub



TextStream


تسهیل دسترسی متوالی به فایل 



Methods of the TextStream Object

 

Property

Description

Close

Closes an open TextStream file.

Read

Reads a specified number of characters from a TextStream file and returns the resulting string.

ReadAll

Reads an entire TextStream file and returns the resulting string.

ReadLine

Reads an entire line (up to, but not including, the newline character) from a TextStream file and returns the resulting string.

Skip

Skips a specified number of characters when reading a TextStream file.

SkipLine

Skips the next line when reading a TextStream file.

Write

Writes a specified string to a TextStream file.

WriteLine

Writes a specified string and newline character to a TextStream file.

WriteBlankLines

Writes a specified number of newline characters to a TextStream file.

 


Properties of the TextStream Object

 

Property

Description

AtEndOfLine

A Boolean indicating whether or not the file pointer is at the end of a line in the text file (used when reading character by character).

AtEndOfStream

A Boolean indicating whether or not the file pointer is at the end of file (used when reading line by line).

Column

The column number of the current character position in a TextStream file.

Line

The current line number in a TextStream file.







FileSystemObject



("Set fso=CreateObject("Scripting.FileSystemObject
    (Set fld = fso.GetFolder(strSourcePath

For Each sfldr in fld.Subfolders
Debug.Print sfldr.Name
Next

 گرفتن فایل های داخل فولدر 

Set fls=fld.Files
 For Each f In  fls
Debug.Print f.Name
Next


MethodDescription
CopyFileUsed to copy an existing file.
CopyFolderUsed to copy an existing folder.
CreateFolderUsed to create a folder.
CreateTextFileUsed to create a text file.
DeleteFileUsed to delete a file.
DeleteFolderUsed to delete a folder.
DriveExistsUsed to determine whether a drive exists.
FileExistsUsed to determine whether a file exists.
FolderExistsUsed to determine whether a folder exists.
GetAbsolutePathNameUsed to return the full path name.
GetDriveUsed to return a specified drive.
GetDriveNameUsed to return the drive name.
GetFileUsed to return a specified file.
GetFileNameUsed to return the file name.
GetFolderUsed to return a specified folder.
GetParentFolderNameUsed to return the name of the parent folder.
GetTempNameUsed to create and return a string representing a file name.
MoveFileUsed to move a file.
MoveFolderUsed to move a folder.
OpenTextFileUsed to open an existing text file


r = Range("A65536").End(xlUp).Row + 1

For Each FileItem In SourceFolder.Files

    'Display file properties
     Cells(r, 1).Formula = FileItem.Name
     Cells(r, 2).Formula = FileItem.Path
     Cells(r, 3).Formula = FileItem.Size
     Cells(r, 4).Formula = FileItem.DateCreated
     Cells(r, 5).Formula = FileItem.DateLastModified
     
     r = r + 1
     
Next FileItem

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


("Set xls=CreateObject("Excel.Application

. . . . . .  .   Set Wbk=xls.Workbooks.Open 

("Set xlsht=Wbk.WorkSheets("Sheet1



Dim db As Dao.DataBase

Dim rst As Dao.RecordSet

xlsht.Range("A2").Select

("Set rst=db.OpenRecordSet("Select * From Table1

rst.AddNew

rst.Fields("ColA2")=xlsht.Range("A2").Value

rst.Update

rst.Close

Set rst=Nothing

Set db=Nothing








تولید شماره بصورت رندوم Generate Random Number


در قرعه کشی می توان استفاده کرد 


عبارت زیر برای تولید عدد صحیح در محدوده یک تا صد 


:the expression to make the range 1..100

1 + Int( 100 * Rnd())

تولید عدد صحیح بصورت رندوم در یک محدوده خاص : 

The general expression to generate a random integer

: in a particular range is

intLower + Int( (intUpper - intLower + 1) * Rnd())

where intLower and intUpper are the lower and upper limits of the range


تاریخ بصورت رندوم : 

 Sometime in the past week'
(DateAdd( "d", Int( -7 * Rnd()) , Date
 Sometime in the past year'
(DateAdd( "m", Int( -12 * Rnd()) , Date


Trur Or False 

Generating a random value of True or False is also

: easy


Rnd() > 0.5

قرعه کشی در اکسس






()Private Sub CmdClear_Click

""=  Me.lstData.RowSource 

End Sub


()Private Sub Form_Timer

 (  Me.txtDigitOne = CInt(Rnd() * 9

( Me.txtDigitTwo = CInt(Rnd() * 9

(   Me.txtDigitThree = CInt(Rnd() * 9

   

End Sub

پنهان کردن سکشنی در گزارش




Private Sub GroupFooter0_Format(Cancel As Integer, FormatCount As Integer)
' note that this is linked to the Format event of the Footer0
If Me!MyCount > 1 Then
GroupFooter0.Visible = True
Else
GroupFooter0.Visible= False
End If
End Sub

ERROR 3021 : No current record



With frm.RecordsetClone
        Bookmark = frm.Bookmark.
        X = .AbsolutePosition + 1
    End With



مرتب سازی رکوردهایی با مقدار عددی ذخیره شده در فیلد تکست



در تب Home در گروه Sort & Filter روی Advanced و سپس در شورت کات منو روی Advanced Filter/Sort کلیک بنمائید 

عبارت زیر را در  expression تایپ نمائید در اولین ستون  و اولین ردیف . تابع IIf بررسی میکند که آیا مقدار فیلد Null است و اگر چنین باشد بعنوان صفر عمل می کند . اگر مقدار Null نباشد تابع IIf تابع Val را برای بدست آوردن معادل عددی آن فراخوانی میکند.

((Expr1: IIf([Fieldname] Is Null, 0, Val([Fieldname

در سل Sort انتخاب کنید Ascending نمایش بصورت صعودی یا Descending نمایش بصورت نزولی





mdlRownumbers Module




Private lngRowNumber As Long
Private colPrimaryKeys As VBA.Collection

Public Function ResetRowNumber() As Boolean
Set colPrimaryKeys = New VBA.Collection
lngRowNumber = 0
ResetRowNumber = True
End Function

Public Function RowNumber(UniqueKeyVariant As Variant) As Long
Dim lngTemp As Long

On Error Resume Next
lngTemp = colPrimaryKeys(CStr(UniqueKeyVariant))
If Err.Number Then
lngRowNumber = lngRowNumber + 1
colPrimaryKeys.Add lngRowNumber, CStr(UniqueKeyVariant)
lngTemp = lngRowNumber
End If

RowNumber = lngTemp
End Function

تابع GetTickCount



توابع  windows/win32/kernel32/api/index.htm



تعداد میلی ثانیه هایی که از زمان شروع کار سیستم باقی مانده اند ، را تا 49.7 روز بازیابی می کند. در سیستم 64 بیت


Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long