جمع ساعات در اکسس

برای جمع ساعات ذخیره شده در جدول اکسس می طلبد که از Vba استفاده کنید . یک تابع public بنویسید . 

نحوه کار بدین صورت است که اول می بایست تک به تک مقادیر h و m و s را بگیرید و با هم جمع بزنید اول از ثانیه شروع بکنید و به اضای هر 60 ثانیه یک عدد به دقیقه اضافه کنید و زمان جمع دقایق می بایست به اضای هر 60 دقیقه یک عدد به ساعت اضافه شود 

8:30:15

10:12:30

9:20

در یک کوئری فرضا اختلاف بین دو Time را ذخیره می کنید بنام difftime و یک کوئری دیگر می سازید و عبارت زیر را کپی می کنید البته در تابع زیر تایپ می بایست فرمت  date\time  باشد وگرنه ارور میدهد یا می بایست date را از تابع حذف کنید.

x : Sum(Total(difftime))

s=15+30=45

m=30+12+20=62

h=8+10+9=27

خارج قسمت با \ بدست می آید فرضا در 60\195 عدد 3 به Minute اضافه میشود و باقیمانده با Mod که طبق عبارت فوق عدد 15 بدست می آید و همان ثانیه است.

45\60=0
195\60=3
45 Mod 60=45
195 Mod 60=15

60\60=1

60 mod 60=0

0 mod 0 or 0\0=undefined and raise error !!!

در لینک زیر میتوانید بجای تابع Len از عبارات بالا استفاده کنید در صحت مقادیر بدست آمده 

www.w3schools.com/sql/

Use Nz Function 

Public Function TotalHours(tm) as date

اگر tm  از نوع تکست باشد باید تک تک h ، s و m را با mid Function بگیرید !!! یا تبدیل به فرمت date\time کنید

Dim h,m,s,mm,ss as integer

h=Hour(tm)

m=Minute(tm)

s=Second(tm)

ss=iif(nz(s)\60=0,nz(s),nz(s) mod 60)

If  nz(s)\60>0  Then m=m+s\60

mm=iif(nz(m)\60=0,nz(m),nz(m) mod 60)

If nz(m)\60>0 Then h=h+m\60

TotalHours=format$(.....,"Short time")

Exit Function

Second (#10:42:58 PM#)
Result: 58
Second (#10:14:13 AM#)
Result: 13
Second (#22/11/2003 10:01:04 PM#)
Result: 4

vba/access/concepts/date-time/calculate-elapsed-time

پاس دادن یا انتقال مقدار فیلدی از فرمی به فیلدی در فرم دیگر

I am writing VBA on Microsoft access
Do anyone know how can i set a value of a form's field by using VBA?
For example, I am writing the VBA code on form A and want to set value to a field in form B (because I haven't learnt how to pass value between forms)

Or
How can i write VBA to open a new form with value set to a particular field?

دارم Vba در Microft Access می نویسم

آیا کسی می داند چگونه می توانم با استفاده از Vba  فیلدفرمی را  مقدار بدهم؟

برای مثال کدی روی فرم A می نویسم و میخواهم مقداری را به فیلدی ؟ در فرم B قرار بدهم ( بخاطر اینکه من پاس کاری یا انتقال مقدار بین فرم ها را یاد نگرفته ام)

یا چگونه می توانم Vba بنویسم تا فرم جدیدی  را باز کند با مقداردادن به یک فیلد بخصوصی ؟ 

Can anyone help me? I have been doing this for 4hr and still can't find the solution.

Thanks very much

کسی می تواند کمک کند؟ برای ۴ ساعت داشتم این کار را انجام میدادم و هنوز راه حلی نمی توانم پیدا کنم 

متچکرم خیلی زیاد 

جواب بزرگوارانی چون ایشان را اینطور داده اند

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

With both forms open, try:

Me.NameOfSomeControl = Forms!NameOfForm!NameOfSomeControl

اگر در نام فرم یا کنترل ها فاصله ای وجود دارد نام اشیا ( منظور فرم یا کنترل را با براکت   [ ] محصور کنید.

If the form or control names have spaces, enclose the object names in square brackets.

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

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

فرضا در CLASS می نویسید   PUBLIC STOREVAR 

و کامندی در فرم A تعبیه کرده اید که کاربر وقتی دکمه ای را کلیک میکند فرم بسته و فرم B باز میشود می بایست مقداری از فرم A به کنترلی در فرم B منتقل شود در کامند باتن آن مقدار را به STOREVAR می دهید بعد زمان بازشدن فرم B میگوئید که آنرا در کنترل سورس فیلد یا آبجکتتون قرار بدهد 

FIELD1=STOREVAR

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

 STOREVAR=""

ساختن دوباره Primary keys

زمانیکه در جدول سینگلی که فیلد AutoNumber دارد رکوردی را حذف میکنید دیگر شماره های پشت سر هم را ندارید و می بایست چاره ای بیاندیشید یک راه این است که جدول را در نمای دیزاین باز کنید فیلد AutoNumber را حذف کنید جدول را ببندید و Compact Database را از Option  بزنید و دوباره فیلد را به جدول اضافه کنید. برای جداولی که بهم ربط دارند در پیوندها توصیه آفیس را اجرا کنید با عنوان Reset AutoNumber.

Add This Code on Form Close Event whether you add new record or delete, it will recreate the Primary Keys from 1 to Last record.This code will not disturb other columns of table.

کد زیر را به رویداد Close فرمتون اضافه کنید مان Add یا Delete کردن رکورد جدید دوباره Prinmary Keys را از یک تا آخرین رکورد می سازد.این کد فقط مربوط به اولین فیلد است و به سایر ستون های جدول اعمال نمی گردد 

Sub updatePrimaryKeysOnFormClose()

Dim i, rcount As Integer 

'Declare some object variables 

Dim dbLib As Database 

Dim rsTable1 As Recordset 

تنظیم کردم dbLib به دیتابیس جاری

'Set dbLib to the current database (i.e. LIBRARY)

Set dbLib = CurrentDb

باز کردن شئ رکوردشت برای جدول Table1 

'Open a recordset object for the Table1 table

Set rsTable1 = dbLib.OpenRecordset("Table1")

شمارش رکوردهای رکوردست 

rcount = rsTable1.RecordCount 

'== Add New Record ============================

اضافه کردن رکورد جدید البته از Edit استفاده شده می توانید از rs.MoveFirst استفاده کنید 

'Rs.MoveLast

'Rs.MoveFirst

'rCount=Rs.RecordCount

 For i = 1 To rcount 

With rsTable1 

.Edit 

.Fields(0) = i 

.Update 

'-- Go to Next Record ---

.MoveNext 

End With 

Next 

Set rsTable1 = rsTable1 

End Sub

alter-table-statement-microsoft-access-sql

Sql  : (AutoNumber Field Value )

CurrentDB.Execute "ALTER TABLE yourTable ALTER COLUMN myID COUNTER(1,1)"

WNDPROC

متغیرهایی تعریف شده که زمان ارجاع به آن راحت باشید و مقادیری را به آن تخصیص بدهید با Private Type و مشخص کردن نام و دیتا تایپ آن.

Private Type CUSTOM_MSGBOX lTimeout As Long
lExitButton As Long
lInterval As Long
strPrompt As String
End Type

Public cm As CUSTOM_MSGBOX

برای آفیس 32 بیت است نه 64 برای 64 باید Longptr شود .

Private Function WinProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 

Dim hwndCaption As Long 

Dim CurrentStyle As Long 

Dim ClassName As String 

Dim lResult As Long 

Dim Timeout As Long 

اگر پنجره ای فعال شد می بایست ClassName آنرا گرفته و چنانچه 32770 بود یعنی درست است و مطمئن میشوید که خود پنجره مسیج باکس است.

If lMsg = HCBT_ACTIVATE Then

ClassName = Space(256)

lResult = GetClassNameA(wParam, ClassName, 256)

If Left(ClassName, lResult) = "#32770" Then

' Make sure we spotted a messagebox (dialog)

hwndMsgBox = wParam 

Timeout = cm.lInterval 

'IIntrval=10000 Miliseconds

If Timeout = 0 Then

Timeout = cm.lTimeout 

If cm.lTimeout Then 

در اینجا تابع SetTimer عمل میکند و تابع TimeHandler اجرا می شود 

lTimerHandle = SetTimer(0&, 0&, Timeout, AddressOf TimerHandler)

از بین بردن hook که توسط SetWindowsHookEx نصب شده

'Remove Hook Procedure installed By a hook chaib  SetWindowsHookEx 

UnhookWindowsHookEx hHook 

End If

End If 

این خط مهم است وگرنه خطا ایجاد میکند.

WinProc = False 

End Function 

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long 

Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

Private Declare Function PostMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function SetDlgItemTextA Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long 

Private Const WM_LBUTTONDOWN = &H201

Private Const WM_LBUTTONUP = &H202

Public Const IDPROMPT = &HFFFF&

Public Sub TimerHandler(hwnd As Long, uMSG As Integer, idEvent As Integer, dwTime As Double)

Dim hWndTargetBtn As Long

cm.lTimeout = cm.lTimeout - cm.lInterval  SetDlgItemTextA hwndMsgBox,IDPROMPT,

 Replace(cm.strPrompt, "%T",CStr(cm.lTimeout / 1000)) 

If cm.lTimeout <= 0 Then

hWndTargetBtn = GetDlgItem(hwndMsgBox, cm.lExitButton) 

' set the focus to the target button and ' simulate a click to close the dialog and ' return the correct value

فوکس را به باتن مقصد می برد و پیام ویندوزی LButtonDown و سپس LButtonUp را به پنجره باتن ارسال میکند و در نتیجه Close انجام میشود ( یک کلیک را تصویر گری می کند )

If hWndTargetBtn <> 0 Then 

SetFocus hWndTargetBtn

DoEvents

Call PostMessageA(hWndTargetBtn, WM_LBUTTONDOWN, 0, ByVal 0&)

Call PostMessageA(hWndTargetBtn, WM_LBUTTONUP, 0, ByVal 0&)

End If 

End If 

End Sub 

Private hHook As Long

Public hwndMsgBox As Long

Public lTimerHandle As Long

Public hAppInstance As Long

Public Function vbTimedMsgBox(Prompt As String,Optional Buttons As VbMsgBoxStyle = vbOKOnly,Optional Title As String, Optional Timeout As Long = 0,Optional Tick As Long = 1000,Optional DefaultExitButton As ExitButton = IDOK) As Long 

cm.lTimeout = TimeOut

cm.lExitButton = DefaultExitButton

hAppInstance =GetWindowLong(hWndAccessApp, GWL_HINSTANCE) 

' Access specific. In VB, this would be App.hInstance

hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc, hAppInstance, 0)

vbTimedMsgBox = MsgBox(Prompt, Buttons, Title) 

End Function

این یک نمونه کار است هر زمان که توابع API را مطالعه کردید می توانید با چیدمان درست کدها به مقاصد خود دست یابید البته هوک کردن مشکل است اگر خطایی اتفاق بیافتد سیستم هنگ خواهد کرد به WSCRIP.SHELL و POPUT هم می توان مراجعه کرد .

CREATEOBJECT("WSCRIPT.SHELL")

OBJECT.POPUP

Wscript Popup Method vbsedit

Echo Method vbsedit

Wscript.Shell + Shell.Application Objects shell.html

فرضا ساختن مرجع آبجکت یا شئ به یک فولدر با متد NAMESPACE از آبجکت SHELL.APPLICATION

filesystemobject-object

FolderItems.Count property :

Contains the number of items in the collection.


ssfWINDOWS = 36

Dim objShell,objFolder As Object

Set objShell =CreateObject("Shell.Application")

Set objFolder = objShell.NameSpace(ssfWINDOWS)

Set objFolderItems = objFolder.Items

nCount = objFolderItems.Count

Debug.Print nCount

روش انتقال متن فارسی به دکمه های اجرایی موجود در Msgbox

اگر کسی کدی داره درباره این موضوع در نظرات کپی کنه تا دیگران هم استفاده کنند برای اینکار از توابع Windows استفاده شده و روش Hook کردن پنجره Msgbox و ارسال پیغام با SendMessageA است.برای ویندوز 32 بیت و 64 روش اظهار تابع فرق میکند.

اگر در نظر سنجی شرکت کنید و موافقت خودتون را در نظرات اعلام کنید به زودی کد خط به خط در اینجا از سایت های خارجی استخراج ودر معرض عموم قرار خواهد گرفت.

MsgBox ( prompt [, buttons ] [, title ] [, helpfile ] [, context ] 

Hooks-Win32 application

SetWindowsHookEx :
Installs an application-defined hook procedure into a hook chain. You would install a hook procedure to monitor the system for certain types of events. These events are associated either with a specific thread or with all threads in the same desktop as the calling thread

UnhookWindowsHookEx :
Removes a hook procedure installed in a hook chain by the SetWindowsHookEx function

CallNextHookEx :
Passes the hook information to the next hook procedure in the current hook chain. A hook procedure can call this function either before or after processing the hook information.

CallWndProc :
An application-defined or library-defined callback function used with the SetWindowsHookEx function. The system calls this function before calling the window procedure to process a message sent to the thread

winuser-messageboxa

IDOK1
IDCANCEL2
IDYES6
IDNO7

winuser-hookproc

Hookproc(nCode,wparam,lparam)

CbtProc https://

getcurrentthreadid

setdlgitemtexta

با تابع بالا پیغامی را به پنجره دیالوگ باکس میدهید که Title یا تکست کنترل مورد نظر تنظیم شود 

در ویندوز 64 بیت نحوه اظهار کردن یک PtrSafe قبل از Function آمده و در بعضی از آرگومانها بجای تایپ Long از LongPtr استفاده شده.

#If VBA7 Then

Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare PtrSafe Function SetDlgItemTextA Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long

Private Declare PtrSafe Function SetWindowsHookExA Lib "user32" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr 

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long

Private Declare PtrSafe Function MessageBoxL Lib "user32" Alias "MessageBoxW" ( _
  ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, _
  ByVal wType As Long) As Long
Private

End If

'Declaration API functions of User32.DLL. for Office 32 or 64-bit

#If VBA7 Then

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#Else
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long #End If 

توابع ویندوزی برای مسیج باکس : 

lpText

The message to be displayed. If the string consists of more than one line, you can separate the lines using a carriage return and/or linefeed character between each line.

lpCaption

The dialog box title. If this parameter is NULL, the default title is Error.

#If VBA7 Then
Private Declare PtrSafe Function MessageBoxA Lib "user32" ( _ ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#Else
Private Declare Function MessageBoxA Lib "user32" ( _ ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long #End If

wType
To indicate the buttons displayed in the message box, specify one of the following

برای مشخص کردن اینکه کدام باتن ها در پنجره Message Box نشان داده شوند  از اعداد هگزاگون رزور شده استفاده می کنیم که هر کدام معرف باتنی است.

MB_OK=&H0
MB_OKCANCEL=&H1
MB_YESNO=&H4
MB_YESNOCANCEL=3

To display an icon in the message box, specify one of the following values.

برای مشخص کردن آیکونی در این پنجره یکی از مقادیر زیر راانتخاب میکنیم 

MB_ICONEXCLAMATION=&H30

MB_ICONINFORMATION=&H40

MB_ICONQUESTION=&H20

MB_ICONSTOP=&H10

To indicate the default button, specify one of the following values.

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

MB_DEFBUTTON1=&H1

MB_DEFBUTTON2=&H100

MB_DEFBUTTON3=&H200

MB_DEFBUTTON4=&H300

مقادیر رزرو شده زیر هم برای Align کردن استفاده میشود از دومین مقدار در سیستم های عربی برای Right To Left کردن پیامی که میخواهیم در این پنجره نمایان گردد.

MB_RIGHT=&H80000

MB_RTLREADING=&H100000 'Caption

Private Const GWL_HINSTANCE As Integer = (-6)
Private Const HCBT_ACTIVATE As Integer = 5
Private Const WH_CBT As Integer = 5

Private Const EM_SETPASSWORDCHAR = &HCC

Private Const HC_ACTION =0

Private Shared hHook As Integer

Hook Typs : one of them

WH_CBT

The system calls a WH_CBT hook procedure before activating, creating, destroying, minimizing, maximizing, moving, or sizing a window; before completing a system command; before removing a mouse or keyboard event from the system message queue; before setting the input focus;

البته پیشنهاد میشه که یک فرم Custom Message Box بسازید چون Handle کردن پنجره یا پنجره ها با استفاده از توابع ویندوزی سخت است و اگر پنجره خطایی غیر از آن یا پنجره  ای ناخواسته باز شود کد به پنجره دیگری ارسال میشود و درست عمل نخواهد کرد ، در ضمن سیستم هنگ و مجبورید از اکسس خارج شوید با استفاده از Task Manager 

  

شکل تابع بصورت زیر است باید تمرین کنید تا مسلط شوید

  

Public Function Msgboxx(ByVal Prompt As String,Optional ByVal Title As String = "", Optional ByVal buttons As MessageBoxButtons =, Optional ByVal icon As MessageBoxIcon =, Optional ByVal DefaultButton As MessageBoxDefaultButton =, Optional ByVal options As MessageBoxOptions =, Optional ByVal m As MsgBoxStyle =) As DialogResult

hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgboxProc,GetModuleHandle(vbNullString),GetCurrentThreadId

  فرضا در اینجا از InputBox استفاده شده ولی شما بایستی از Msgboxx استفاده کنید 

InputBoxDK = InputBox(Prompt, Title)

UnhookWindowsHookEx hHook

Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, _
ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias _
"GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr


Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32" Alias  (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Private Declare PtrSafe Function GetClassNameA Lib "user32" Alias (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long





Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr

If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)

برای گرفتن ClassName پنجره InputBox که 32770 است از تابع GetClassNameA استفاده شده

strClassName = String$(256, " ")

lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then 'A window has been activated

RetVal = GetClassName(wParam, strClassName, lngBuffer)

چک میکند که اگر پنجره InputBox بود پیامی را با تابع SendDlgItemMessage می فرستد که بجای کاراکتر وارد شده ستاره تایپ شود عرض کردم هندل کردن ویندو سخت است و اگر پنجره ای ناخواسته Run شود ممکن است سیستم هنگ نماید.

If Left$(strClassName, RetVal) = "#32770" Then

SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, asc("*"), &H0

لیست پیام هایی که میشود به Edit control یا تکست باکسی که در InputBox وجود دارد و در آن کاراکتری تایپ می کنید ، فرستاد. لینک زیر

edit-control-reference-messages

خط زیراطمینان حاصل خواهد کرد که سایر Hook ها که ممکن است داخل آن باشد بصورت درست فراخوانی شده باشد.

'This line will ensure that any other hooks that may be in place are 

'called correctly.

CallNextHookEx hHook, lngCode, wParam, lParam

برای لود کردن آیکون هم باید به پنجره پیامی فرستاد و از توابع ویندوزی استفاده نمود که به آن اشاره میشود.فقط Bitmap اگر PNG باشد باید تبدیل شود که به کدهای خیلی زیاد و پیچیده اس احتیاج است و از بحث اکسس خارج .

WM_SETICON message
wParam
ICON_BIG=1
ICON_SMALL=0
lParam
 handle to the new large or small icon. If this parameter is NULL, the icon indicated by wParamis removed.


Public Const WM_SETICON = &H80 Public Const ICON_SMALL = 0 Public Const ICON_BIG = 1


'// LoadImage() image types
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1
Public Const IMAGE_CURSOR = 2
Public Const IMAGE_ENHMETAFILE = 3 '// LoadImage() flags
Public Const LR_DEFAULTCOLOR = &H0
Public Const LR_MONOCHROME = &H1
Public Const LR_COLOR = &H2
Public Const LR_COPYRETURNORG = &H4
Public Const LR_COPYDELETEORG = &H8
Public Const LR_LOADFROMFILE = &H10
Public Const LR_LOADTRANSPARENT = &H20
Public Const LR_DEFAULTSIZE = &H40
Public Const LR_LOADMAP3DCOLORS = &H1000
Public Const LR_CREATEDIBHeader = &H2000
Public Const LR_COPYFROMRESOURCE = &H4000
Public Const LR_SHARED = &H8000


hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE) If hIcon<>0 Then
SendMessageA(hWnd, WM_SETICON, 0, ByVal hIcon)

در سیستم آفیس 32 بیت البته 

Private Declare Function LoadImageA Lib "user32  (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long

------------------------------

مثالی دیگر از MSGBOXHOOKPROC : 

SetDlgItemTextA function
Sets the title or text of a control in a dialog box.

SetDlgItemTextA( HWND hDlg, int nIDDlgItem, LPCSTR lpString)


Dim mFlags As VbMsgBoxStyle

Public Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = HCBT_ACTIVATE Then
SetWindowText wParam, mTitle
SetDlgItemText wParam, IDPROMPT,mPrompt

Select Case mFlags
 
Case vbAbortRetryIgnore
SetDlgItemText wParam, IDABORT, But1 SetDlgItemText wParam, IDRETRY, But2
SetDlgItemText wParam, IDIGNORE,But3

Case vbYesNoCancel
SetDlgItemText wParam, IDYES, But1
SetDlgItemText wParam, IDNO, But2 SetDlgItemText wParam, IDCANCEL,But3

Case vbOKOnly
SetDlgItemText wParam, IDOK, But1

Case vbRetryCancel
SetDlgItemText wParam, IDRETRY, But1
SetDlgItemText wParam, IDCANCEL,But2

Case vbYesNo
SetDlgItemText wParam, IDYES, But1 SetDlgItemText wParam, IDNO, But2

Case vbOKCancel
SetDlgItemText wParam, IDOK, But1 SetDlgItemText wParam, IDCANCEL, But2

End Select

UnhookWindowsHookEx hHook
End If

MsgBoxHookProc = False
End Function

Public Function
  

------------------------------

مثالی دیگر با استفاده از توابع API 

You need to use Windows Hooking API

You must create a CBT hook
Run a Message Box with CBT hook
Catch a HCBT_ACTIVATE message in the Hook procedure
Set new captions for the buttons using the SetDlgItemText function
(example below changes “Yes” and “No” captions to smiles: “:-)” and “:-(” )
Release the CBT hook


Public Sub MsgBoxSmile()
' Set Hook
hHook=SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc,0, GetCurrentThreadId)
'Run MessageBox
MsgBox "Smiling Message Box", vbYesNo, "Message Box Hooking"
End Sub  

Private Function MsgBoxHookProc(ByVal lMsg As Long,ByVal wParam As Long, ByVal lParam As Long) As Long  

If lMsg = HCBT_ACTIVATE Then 

SetDlgItemText wParam, IDYES, ":-)" 

SetDlgItemText wParam, IDNO, ":-("  

' Release the Hook UnhookWindowsHookEx 

hHook 

End If

MsgBoxHookProc = False 

End Function

در مثال یاد شده MsgBoxSmile را در رویداد یک باتن بگذارید اگر مشکلی پیش نیاید و پنجره MSGBOX را HOOK نماید ( گفته است که این پنجره شامل دوکلید YES و NO باشد) TEXT داخل این دو باتن تغییر خواهد کرد 

البته روش هوک کردن کار درستی نیست بخاطر اینکه زمان کار با کلیدها مسیج های زیادی رد و بدل میشود و چنانچه HWND پنجره درست بدست نیاید کار بیهوده ای خواهد بود و ممکن است سیستم هنگ و در پیش برد برنامه خللی وارد بنماید که مایکروسافت آفیس چنین پیشنهادی را نخواهد داد و عنوان می کنند که اگر کسی راغب است یک فرم بعنوان CUSTOM MESSAGE BOX بسازد و در آنها باتن هایی تعبیه نماید در نتیجه OFFICE هیچوقت پیشنهاد HOOKING را ارائه نخواهد داد....

Shell Object

windows/win32/shell/shell

Private WithEvents Win As WebBrowser
Sub SetWin()
Dim WinShell 'As New Shell32.Shell
Set WinShell = CreateObject("Shell.Application")
Set Win = WinShell.Windows(1)
End Sub
Private Sub Win_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)
End Sub

WebBrowserControl ... ActiveX

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

Private Sub lblBrowse_Click()

'declare file dialog with late binding ->
Dim fDialog As Object, strPath As String
Set fDialog = Application.FileDialog(3) 'msoFilePicker

'set parameters ->
Me.wbContent.ControlSource = ""

    'initializing the file dialog ->
    With fDialog
        .AllowMultiSelect = False
        .Filters.Clear        '
        .title = "Please select a file..."

        'display the dialog box. If the .Show method returns True
        'the user picked a file. If the .Show method returns False
        'the user clicked Cancel.
        If .show = True Then
            strPath = .SelectedItems(1)
            Debug.Print "SELECTED_FILE: " & strPath

            'set source property to the string containing the full path ->
            Me.wbContent.ControlSource = strPath
            Me.wbContent.Requery
        Else

        End If
    End With

البته جواب نمیدهد خودتان را خسته نکنید ممکن است برای بعضی در WebBrowser نمایش داده شود.

Me.wbContent.ControlSource = "='" & strPath & "'"

WebBrowserControl.ControlSource Property : 

روی چک باکس یا Toggle Button عمل نمیکند ( ControlSource )

استفاده از پراپرتی ControlSource برای نمایش داده در کنترل

نمایش و  ویرایش داده متصل به یک جدول کوئری یا عبارت Sql یا نمایش نتیجه یک عبارت .( فرضا حاصلضرب دو تکست باکس یا فیلد از جدول یاکوئری)

You can use the ControlSource property to specify what data appears in a control. You can display and edit data bound to a field in a table, query, or SQL statement. You can also display the result of an expression. Read/write String.

Navigate2 Method  --->> internet-explorer

NavigateComplete2 event --->>  internet-explorer

expression.DocumentComplete (pDisp, URL)


pDisp  ( Required,Object)
A pointer to the IDispatch interface of the window or frame in which the document is loaded.
URL (Required,Variant)
Contains the URL of the loaded document.
Return value : Nothing

ByVal pDisp As Object

ByVal Url As Variant

Private Sub object_DocumentComplete( _
  ByVal pDisp As Object, _
  ByVal URL As Variant)

Document/getElementById

Set wb = WebBrowser0.Object 

wb.Silent = True

With wb

    .Navigate2 "about:blank"
    Do Until .ReadyState = 4 '=READYSTATE_COMPLETE
        'This is a somewhat inefficient way to wait, but loading a blank page should only take a couple of milliseconds
        DoEvents
    Loop
    .Document.Open
    .Document.Write "<!DOCTYPE html><HTML><HEAD><TITLE>My title</TITLE></HEAD><BODY scroll=""auto"" style=""margin: 0px; padding: 0px;"">" & _
                        "<embed src=""" & fileLocation & """  width=""100%"" height=""100%"" />" & _
                        "</BODY></HTML>"
    .Document.Close
End With

With Me.WebBrowser0.Object.Document.Open
.Write "<html><head></head><body><p>Some content.</p></body></html>"
.Close
End With

Opening A Blank Page
Me.WebBrowser0.ControlSource = "about:blank"

Me.WebBrowser0.Object.Document.parentWindow.execScript ("alert('Your Access Database " & Application.CurrentProject.Name & " rocks!');")

Me.WebBrowser0.Object.Document.body...


<!DOCTYPE html> <!-- saved from url=(0016)http://localhost --> <html> <head>

بخوانید و لذت ببرید 

جمع آوری از سایت های مختلف

OnLoad :
WebBrowser1.Navigate ("http://www.vbcity.com/forums/active.asp";) 'Replace with URL


Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    
 Next


Public WithEvents hDoc As MSHTML.HTMLDocument
Hdoc_ContextMenu=False

htmldocument

htmlcollection_loop

می توانید طبق لینک بالا لوپ را باکدهای HtmlDocument انجام بدهید ؟ در نظرات کد و نتیجه آن را مرقوم بفرمائید.

document

Dim HTML As HTMLDocument
Set HTML = WebBrowser1.Document HTML.All.Item("UNTextbox").Value = "UserName"
HTML.All.Item("PWTextbox").Value = "Password"
HTML.All.Item("LoginButton").Click

ورود داده به باکس UserName : 

Me.WebBrowser1.Navigate="Url" ' if be true

Me.WebBrowser1.Document.All("UserName").Value = "tester"

For Each ele In WebBrowser1.document.getelementsbytagname("a")

 If ele.innertext = "Log Out" Then

 ele.onclick = ""

 ele.click

 Exit For

  End If

Next

Private WithEvents m_body As MSHTML.HTMLBody

   MsgBox "You clicked the page's body", vbInformation
Private Function m_body_onclick() As Boolean
End Function

Web Browsing Objects htm

browser-object-model

WebBrowser.GoForward Method webbrowser

WebBrowser.GoBack Method  webbrowser

Me.WebBrowser1.Document.Window.ScrollTo(0, 300)

WebBrowser1.Document.body.Scroll = "no"

CommandStateChange : برای فعال یا غیرفعال کردن دکمه های Forward و Back در مرورگر استفاده می شود . شکل کلی فراخوانی این event بصورت زیر است :

Private Sub WebBrowser1_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)

که command فرمانی است که حالت فعال آن تغییر کرده است و دو مقدار می گیرد : 1 و 3 که بترتیب معادل فرمانهای GoForward و GoBack هستند .

Enable فعال یا غیرفعال بودن فرمان را تعیین می کند .

internet-explorer

2 – DocumentComplete : این event زمانی فعال می شود که صفحه در حال load شدن به حالت ReadyState_Complete برود . شکل کلی فراخوانی این event بصورت زیر است :

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

که pDisp ارجاعی به کنترل webbrowser است که event در آن رخ داده است و URL آدرس صفحه در حال load شدن است .
3 – DownloadBegin : این event در آغاز حرکت به صفحه جدید روی می دهد و هیچ پارامتری نمی گیرد . مرورگر می تواند در این event پیغامی برای شروع عملیات جدید نشان می دهد .
4 – DownloadComplete : این event در پایان عملیات یا در صورت انصراف کاربر یا بروز خطا روی می دهد .
5 – ProgressChange : با بروز هر تغییری در وضعیت load ، این event روی می دهد . شکل کلی فراخوانی آن بصورت زیر است :

Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)


که Progress نشان دهنده پیشرفت عملیات ( بایتهای load شده ) است . پارامتر ProgressMax تعداد کل بایتهایی که باید load شوند را نشان می دهد بنابر این :

(Progress/ProgressMax)*100=درصد پیشرفت عملیات load

Re: Disable webbrowser

Private Sub WebBrowser1_BeforeNavigate2(ByVa pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)

If Me.Visible Then Cancel = True

End Sub

If you don't want cursor or clicking then place the control in a frame and then disable the frame. Also format the border to none and clear caption.

You will need to comment out the code you currently have that moves the webbrowser control.

Rich Text Control - Using HTML

<a href="http://www.stackoverflow.com">http://www.stackoverflow.com</a>
<a href="mailto:[e-mail]">mailto:[e-mail]</a>

Support HTML in Rich Text Control : 

<div>,<font>,<strong>,<em>,<u>,<ol>,<ul>,<li>,<blockquote>

<font>: face, size, color, style(with BACKGROUND-COLOR only)    
<div>: align, dir

You can't select 11pt, because Access Richtext (actually HTML) doesn't store point sizes, but a fixed set of <font size=1> to <font size=7>.


strText = "<div><font face=Arial size=2>" & strText & "</font></div>"


The following table shows supported rich text formatting options:
Font name
Font Size
Bold
Italic
Underline
Align Left
Center
Align Right
Numbering
Bullets
Font Color
Text Hilight Color
Decrease Indent Or Increase
Left-To-Right
Right-To-Left


<h1>The span element</h1>

<p>My mother has
 

Private Sub cmdYellow_Click() Me.txtColored = MakeYellow(Me.txtEnter) End Sub
Public Function MakeYellow(TextToColor As String) As String
'Sets background shading yellow MakeYellow = "<div><font style='BACKGROUND-COLOR:#FFFF00'>" & TextToColor & "</font></div>"
End Function

<div align=justify>Your <strong>Rich Text</strong> goes here.</div>

Loops - For Each

Sub forEachExit()
    Dim element As Variant
    Dim animals(0 To 5) As String
    'We have created an array that can hold 6 elements
    
    animals(0) = "Dog"
    animals(1) = "Cat"
    animals(4) = "Snake"
    animals(2) = "Bird"
    animals(3) = "Buffalo"
    'Here we fill each element of the array
    animals(5) = "Duck-billed Platypus"
    
    For Each element In animals
        'print each element to the immediate window
    'iterates over the animals collection
    
        Debug.Print element
    
End Sub
        If element = "Buffalo" Then Exit For
        'if, at any point, the element becomes equal
        
    Next

The output to the immediate window will be (we exited the loop before all items could be printed):

Dog Cat Bird Buffalo

Dim MyArray() As String



ReDim Preserve MyArray(2)

Public Function HadleOpenForms()

Dim arr() As String

Redim Preserve arr(Forms.Count)

If forms.Count Then

For i=0 To Forms.Count-1

' quotation-marks-in-string-expressions

Arr(i)="" & Forms(i).Name & ""

x=x & iif(x="",",","") & Arr(i)

Next

Debug.Print x

Else 

Exit Function

End If

End Function

تابع بالا را تست کنید چنانچه باید اصلاح شود در نظرات این یادداشت قید کنید و اگر درست است زمانیکه فرم هایتان بصورت Tabbed Document باز است اجرا و نتیجه را در نظرات کپی کنید ( در پنجره immidate window محیط vba اکسس اگر تابع درست عمل کند و خطا ندهد  ، چاپ میشود)

dim intx as integer   
   dim intCount as integer   
   intCount = Forms.count-1
   for intX= intCount to 0 step -1     
    docmd.close acform,forms(intX).name
   next

Arr=Array("...","....","....")

CountOpenFrms = Application.Forms.Count

SysCmd شامل Action و دوتا آرگومان است کد زیر

مقدار عددی را برمی گرداند که مشخص میکند Object 

باز است یا بسته و یا .....

ObjState = SysCmd(acSysCmdGetObjectState, _
    Application.CurrentObjectType, _
    Application.CurrentObjectName)

vba/api/access.acsyscmdaction

Active Object

Sub ActiveObjects()

Dim frm As Form, ctl As Control 

 ' Return Form object pointing to active form.

Set frm = Screen.ActiveForm

MsgBox frm.Name & " is the active form." 

 ' Return Control object pointing to active control.

Set ctl = Screen.ActiveControl

MsgBox ctl.Name & " is the active control " _ & "on this form."

End Sub

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

SendKeys StateMent

The plus sign (+), caret (^), percent sign (%), tilde (~), and parentheses ( ) have special meanings to SendKeys. To specify one of these characters, enclose it within braces ({}). For example, to specify the plus sign, use {+}. Brackets ([ ]) have no special meaning to SendKeys, but you must enclose them in braces.

علائم بالا برای SendKeys اسپشیال و ویژه یا بعبارتی رزروشده هستند ، و باید داخل کروشه باشند و داخل براکت محصور می شوند

sendkeys-statement

SendKeys "^{Tab}"

'Send the string SS64 to the active application:

SendKeys "SS64"

'Press Control and F2 in the active application:

SendKeys ^{F2}

'press the LEFT ARROW key 42 times:

SendKeys {LEFT 42}

Remotly Click Command Button

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

Public Function New_Main() As Form
    Set New_Main = New Form_frmMain
End Function


Sub Test()
    Dim mm As Form
    
    Set mm = New_Main
    Debug.Print mm.Controls.Count
    
    With mm.Form("frmSub")
        Debug.Print .Controls.Count
        Debug.Print .Controls("CommandButton1").Enabled
        .Form.CommandButton1_Click
    End With

End Sub

Clear ClopBoard

برای Windowse 64 Bit قبل از فانکشن PtrSafe قرار دهید و Long هم به LongPtr

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Sub ClearClipboard3()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub

GetData از  DataObject Library : 

dataobject-object

CaptureWindow

capcreatecapturewindowa

hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.hWnd, 0)
    If hCap <> 0 Then
        Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If

لوپ در تمام کنترل های یک تب و تغییر رنگ کنترل فعال

فرم Single دارم با تب کنترل حاوی 15تب . تکست باکس و کمبوباکس های مختلفی در هر تب وجود دارد.فرم unbound است ( به جدولی وصل نیست ) . میخواهم از keypress در تب کنترل استفاده کنم تا در تمام کنترل های تمام تب ها حلقه ایجاد کند و رنگ پس زمینه را به سفید تغییر دهد روی تمام کنترل ها جزکنترل فعال ( فوکس گرفته ) که رنگ پس زمینه آن زرد شود.با Screen.ActiveControl می توانم مشخص کنم اما مطمئن نیستم چگونه اینرا در کدهایی بکار بگیرم تا لوپی بین هر کنترل بزنم. I have a single form with a Tab Control containing 15 tabs. Various Text Boxes and Combo Boxes on each Tab. The Form is unbound. I want to use the KeyPress Event on the Tab Control to loop through all the controls on all tabs and change the background colour to white for all controls except the active control, where I want the background colour to be yellow. I can identify the Screen.ActiveControl but am not sure how to incorporate this into some code that loops through every control. Any bright ideas? Thanks for any help, as I'm new to this! ایجاد حلقه در تمام کنترل های یک فرم :

For Each Ctl In Me.Controls

If Ctl.ControlType=(acTextBox Or  acComboBox) Then

'DO SomeThing

Next

'If Ctl.ControlType=acTextBox Or Ctl.ControlType=acComboBox

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

در خط اول در کنترل های فرم می گردد چنانچه TypeName آن SubForm بود میرود به Form آن و تمام کنترل ها را در پنجره immidiate window محیط Vba نمایش میدهد ( Ctrl+G)

office/typename-function

For Each ctl In frm.Controls
    If TypeName(ctl) = "SubForm" Then
        Debug.Print ctl.Name & " is a SubForm"
        For Each ctlSub in ctl.Form.Controls
            Debug.Print ctlSub.Name
        Next 
    End If
Next

حال در جواب سوال بعد از ایجاد لوپ 

Ctl.BackColor = IIf(Ctl.Name = Screen.ActiveControl.Name, 8454143, 16777215)   

البته در کنترل تب ،  تب هایی وجود دارد و هر تب فقط یک پیج دارد رفرنس به تب خاص و پیج حاوی کنترل ها ( فرضا نام تب کنترل TabCtl0 باشد.)

iTabPage=0    پیج ایندکس تب اول صفر است

For Each Ctl In TabCtl0.Pages(iTabPage).Controls

'iTabPage=iif(iTabPage>15,0,iTabPage=iTabPage+1)

For i=0 To TabCtl0.Pages.Count -1    لوپ در پیج ها 

ControlType Property : 

acBoundObjectFrame	Bound object frame
acCheckBox	Check box
acComboBox	Combo box
acCommandButton	Command button
acCustomControl	ActiveX (custom) control
acImage	Image
acLabel	Label
acLine	Line
acListBox	List box
acObjectFrame	Unbound object frame or chart
acOptionButton	Option button
acOptionGroup	Option group
acPage	Page
acPageBreak	Page break
acRectangle	Rectangle
acSubform	Subform/subreport
acTabCtl	Tab
acTextBox	Text box
acToggleButton	Toggle button

TypeName(Ctl)

Ctl.ControlType

If TypeOf Ctl is .....

No Data In Report

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

The following example shows how to cancel printing a report when it has no data. A message box notifying the user that the printing has been canceled is also displayed.

برای آزمایش این مثال رویه رویداد زیر را به یک گزارش اضافه نمائید.گزارش را زمانیکه حاوی داده ای نیست امتحان بنمائید.

To try this example, add the following event procedure to a report. Try running the report when it contains no data.

Private Sub Report_NoData(Cancel As Integer)
    MsgBox "The report has no data." & _
         chr(13) & "Printing is canceled. " & _
         chr(13) & "Check the data source for the " & _
         chr(13) & "the correct criteria (for " & _
         chr(13) & "report. Make sure you entered " & _
         chr(13) & "example, a valid range of " & _
         chr(13) & "dates),." vbOKOnly + vbInformation
    Cancel = True
End Sub

Form.MouseWheel Event

آرگومان  Count در رویداد MouseWheel اگر غلطک ماوس به سمت جلو بچرخد یا Roll شود مثبت است و اگر به عقب رول شود عدد Count منفی است 

کد زیر تابعی نوشته شده با نام DoMouseWheel که دو آرگومان تعریف کرده یکی گرفتن Form و دیگری lngCount که بین رکوردها جابجا میشود اگر lngCount منفی باشد به رکورد قبلی و اگر مثبت شد به رکورد بعدی میرود با اکشن کامندها.

RunCommand acCmdSaveRecord
        'Move back a record if Count is negative, otherwise forward.
        RunCommand IIf(lngCount < 0&, acCmdRecordsGoToPrevious, acCmdRecordsGoToNext)
        DoMouseWheel = Sgn(lngCount)

  [COLOR="Red"][B] End If[/B][/COLOR] 

رویداد KeyPress ، تبدیل کاراکتر به Upper Case یا حروف بزرگ : 

Private Sub ShipRegion_KeyPress(KeyAscii As Integer) 

 Dim strCharacter As String 

 ' Convert ANSI value to character string. 

 strCharacter = Chr(KeyAscii) 

 ' Convert character to upper case, then to ANSI value. 

 KeyAscii = Asc(UCase(strCharacter)) 

End Sub

KeyAscii For ArrowKeys : 

Left: 20

Down: 18

Right: 19

Up: 17

 : TabControl.KeyDown

در رویداد KeyDown تب کنترل میخواهید جابجاشدن در تب ها را با کد انجام دهید هرچند کلید میانبر Ctrl+Tab یا PageDown و  PageUp هم این کار را انجام میدهد و احتیاجی به نوشتن کدهای زیر نیست 

فرضا با استفاده از کلید ترکیبی Ctrl و Arrow Right یا  Arrow Lefr 

If (Shift And acCtrlMask) > 0 Then
Select Case KeyCode

    Case vbKeyRight

    KeyCode =0

اگر تب کنترل با نام TabCtl0 ساخته باشید ( می توانید از پراپرتی شیت کنترل در نمای دیزاین Name را تغییر دهید). 

اول گرفتن تعداد کل تب پیج های تب کنترل مشخص شده.

TabMax=Tabctl0.Pages.Count

دوم متغیری تعریف می کنید که Value تب کنترل که فوکس گرفته را باضافه یک کند یعنی فرضا اگر روی تب 3 باشید به تب 4 سلکت شود ( Value کار انتخاب تب را انجام میدهد ) .

TabConut=TabCtl0+1

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

TabCtl0=TabCount

عدد صحیح فقط !!! پیج ایندکس تب اول را ملاحظه کنید از صفر شروع شده  ( برای لوپ زدن در تب پیج های باید بگوئید از صفر تا Pages.Count منهای یک ) 

حال تصور کنید فوکس روی تب اول با ایندکس صفر است شما کلید ترکیبی Ctrl و فلش سمت راست را می فشرید شروع به پیمایش میکند رو به جلو ( چون Value +1 میشود ) و به متغیر TabCount نیز اضافه میشود فرض کنید آخرین عدد پیج ایندکس یا Value برای این کنترل 6 باشد ، وقتی Value را برابر 7 قرار میدهد  ( TabConut=TabCtl0+1 ) اروری به شما داده میشود چرا چون ماکزیمم Value در تب 6 است پس برای فرار از این خطا می بایست بگوئید تا زمانی پیش برود که TabCount بزرگتر از TabMax باشد.

در کد زیر اگر TabCount بزرگتر از آخرین Value تب شد Reset یا صفر میشود و به اولین تب پرش میکند و از صفر شروع میکند و هر زمان به آخرین تب رسید و دوباره فلش راست را فشردید به تب اول میرود و ......

If  TabCount > TabMax Then
TabCount = 0
End If
TabCtl0 =TabCount

در Case VbKeyLeft باید بدین شکل تصور کنید که اگر Value کوچکتر از صفر شدمقدار TabCount  به TabMax تغییر کند و در نتیجه بعد از انتخاب تب صفر زمان فشردن دوباره فلش چپ تب آخر را انتخاب میکند 

در VbKeyRight شما Value را باضافه یک میکردید که انتخاب رو به جلو باشد در VbKeyLeft شما منهای یک میکنید تا رو به عقب تب انتخاب شود.

TabConut=TabCtl0-1

اگر بخواهید زمان رسیدن به انتخاب تب آخر همچنان با فشردن کنترل و فلش راست ، تب صفر را انتخاب نکند می توانید بگوئید TabCount=TabMax شود و در VbKeyLeft مقدار متغیر TabCount=0 شود.

ولی همانطور که گفته شد کلیدهای میانبر همین کار را انجام می دهند.

تنها کمی فکر کافیست !!!

Anchor Controls

Have a look at how to anchor controls to the form so they can resize with the form.

Quotation marks within quotes

"Orange " & """" & " Pear"

You will get the following result:

Orange " Pear

ساخت کلاس ماژول

ایجاد 5 Label در فرم : 

Private click1 As New ClickLabel
Private click2 As New ClickLabel
Private click3 As New ClickLabel
Private click4 As New ClickLabel
Private click5 As New ClickLabel
Private Sub Form_Load()
Set click1.ClickLabel = Me.Label0
Set click2.ClickLabel = Me.Label1
Set click3.ClickLabel = Me.Label2
Set click4.ClickLabel = Me.Label3
Set click5.ClickLabel = Me.Label4
End Sub

کلاس ماژول به نام ClickLabel

Private withEvents mlabel as Access.Label

Public Property Get ClickLabel() As Access.Label
  Set ClickLabel = mLabel
End Property
Public Property Set ClickLabel(ByVal lblClickLabel As Access.Label)
  Set mLabel = lblClickLabel
  mLabel.OnClick = "[Event Procedure]"
  mLabel.OnMouseUp = "[Event Procedure]"
 End Property
Private Sub mLabel_Click()
  'run code here
  MsgBox "You clicked label " & mLabel.Name
  If mLabel.ForeColor = vbRed Then
    mLabel.ForeColor = vbGreen
  Else
    mLabel.ForeColor = vbRed
  End If
End Sub
Private Sub mLabel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  MsgBox "You moused up from " & mLabel.Name & "It is associated with record" & mRecordID
End Sub

عملکردش چییست؟  بعد از ایجاد 5  لیبل در فرم  زمانیکه روی لیبل کلیک کنید پیغامی حاوی نام لیبل را به شما نمایش داده و رنگ آن تغییر میکند البته   mRecordID در کدهای بالا اعمال نشده که می توان آنرا هم ساخت و برای هر لیبل ID ساخت.

Set click5.ClickLabel = Me.Label4
click5.RecordID = 5

یک متغیر بنام mRecordID با دیتا تایپ Long تعریف کرده

از Property Get برای گرفتن رویه پراپرتی ( RecordID )  استفاده کرده و از نوع لانگ 

the Property Get statement to define a property procedure that gets the value of a property

و سپس از Property Let استفاده نموده برای تخصیص مقداردر mRecordID 

the Property Let statement to define a procedure that assigns a value to a property

Private mRecordID As Long

Public Property Get RecordID() As Long 

RecordID = mRecordID

End Property 

Public Property Let RecordID(ByVal lngRecordID As Long)

mRecordID = lngRecordID

End Property

you can only use a Property Let procedure on the left side of a property assignment expression or Let statement.

Private mstrPropertyName As String 

Property Get PropertyName() As String 
    PropertyName = mstrPropertyName 
End Property 

' You would use Let because String is a value data type
Property Let PropertyName(rData As String) 
    mstrPropertyName = rData 
End Property 

IMPORTANT : 

The Set statement is used to make a reference of an object to an object variable. You don't have to use the Set keyword, if you are dealing with primitive and native built-in types such as integer, double, string and so on. 

The syntax of Property Set is parallel to the Property Let procedure. The only difference is that the argument is an object data type, and the VBA Set keyword is used for the assignment within the body of the Property Set. The following is an example of hypothetical Property Set procedure that accepts a recordset object and assigns it to a private variable named m_ Products:

PROPERTY SET همراستای PROPERTY LET است و تنها فرقی که دارد این است که دیتا تایپ آرگومان OBJECT است.

Public Property Set Products(Value As ADO.Recordset)
  If Not Value Is Nothing Then
    Set m_Products = Value
  End If
End Property

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

BUT FIRST YOU MUST change the clik procedure behind the command button from

"Private Sub cmdButton_Click()" to "Public Sub cmdButton_Click()".

تبدیل Private به Public و تامام 

ساخت Navigation Bar با Command Button

انتقال باتن ها به موقعیت جدید و رو به پائین در فرم 

تصور کنید سه کامند باتن ساخته و زیر هم قرار داده اید و بعنوان Menu از آن استفاده می نمائید.

 پراپرتی Name باتن ها را به M0 تا M2 تغییر داده اید.

حال در ذهن تصور کنید زمان کلیک کردن روی اولین باتن بنام M0 ،  زیر آن به اندازه 3 برابر ارتفاع این باتن به سمت پائین انتقال  یابد و بالطبع می بایست پراپرتی Top باتن های M1 و M2 نیز تغییر یابند.

زمان کلیک روی باتن M1 می بایست فاصله ایجاد شده Clear شده و زیر این باتن به اندازه ی 5 برابر ارتفاعش فاصله ایجاد کند بالطبع در موقعیت پراپرتی Top باتن M2 نیز تاثیر گذاراست.

زمان کلیک کردن روی باتن M2  می بایست فاصله ایجاد شده Clear شده و زیر این باتن به اندازه یک برابر ارتفاعش فاصله ایجاد کند و بالطبع چون زیر آن باتنی نیست پس پراپرتی Top هم بی اثر است.

در ضمن چنانچه روی باتن M2 کلیک کرده اید که فاصله ایجادشده زمان کلیک کردن دوباره یا کلیک کردن روی باتن دیگر فاصله Clear شده و در صورت کلیک روی باتن دیگر فاصله ی مربوطه ایجاد شود.

برای Clear یا برگشت باتن ها به همان موقعیت اولیه می بایست در رویداد لود فرمی که باتن ها قرار دارند پراپرتی Top آن ها را در متغیرهایی ذخیره کرد.

زمان کلیک روی M0 

M1.Top=M1.Top+3xM1.Heigth

M2.Top=M1.Top+M1.Heigth

زمان کلیک روی M1 ( پاک کردن فاصله ایجاد شده یا به موقعیت اولیه برگرداندن باتن ها )

M0.Top=که چون بالاتر است تغییری ندارد

M1.Top=PrimaryValue ( Store in variable )

یا

پراپرتی Top کنترل M1 باید بشود Top کنترل M0 باضافه یک ارتفاع کنترل M0 و خب باتن ها در اینجا ارتفاعشان یکیست اگر ارتفاع فرق کند کدهای بیشتری احتیاج است 

M1.Top=M0.Top+1×M0.Heigth

Top کنترل M0 که تغییری نمیکند چون در بالاترین موقعیت قرار دارد . TOP کنترل M2 یا سومین باتن میشود TOP خود باتن باضافه 5 برابر ارتفاع کنترل .( 5 چیست ؟  در بالاتر گفته شد )

M2.Top=M2.Top+5×M2.Heigth

در صورتیکه ارتفاع کنترل کامند باتن ها یکی باشد شما احتیاجی به کد نویسی بیشتری ندارید و از Top همان کنترل اول و Heigth هر کنترلی که در آن هستید می توانید برای مقاصد خود  استفاده بنمائید.

حال اگر روی M1 کلیک کردید و فاصله زیر آن ایجاد شد و دوباره روی همان M1 کلیک کردید می بایست فاصله حذف ( البته تغییر موقعیت باتن های بعدی باید از آن یاد کرد ) و کل باتن ها در موقعیت اولیه خودشان قرار بگیرند یعنی همان پراپرتی Top خودشان را که از قبل داشتند. حال چه کاری باید انجام داد؟؟؟؟

چون اگر دوباره روی همان باتن M1 کلیک کنید موقعیت M2 تغییر خواهد کرد و به همان موقعیتی که در اولین کلیک رفته  ، شروع اضافه شدن به پراپرتی TOP خواهد بود یعنی با هر بار کلیک روی باتن M1 باتن M2 به پائین و پائین تر حرکت میکند و این خواسته ی ما چی ؟ نیست.

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

در فرآنید یاد شده در این یادداشت فاصله باتن ها نسبت به هم صفر است اگر بین باتن ها فاصله گذاشته باشید باید آنرا هم در نظر بگیرید ( PADDING ) و به کدتون اضافه کنید.

برای کد نویسی قبل از اینکه از رویدار OnClick هر باتن استفاده کنید باید رویه ی پایلیکی بنویسید که در باتن های 0 تا 2 ( M0 TO M2 ) لوپ بزند و پراپرتی TOP باتن های بعد از باتن فشرده شده را به جلو براند و باتن های قبل از آن  به موقعیت قبلی خود بازگردند.

فرض کنید باتن M1 را فشردید اول عدد آن را استخراج می کنید و در متغیری ذخیره می کند فرضا میشود X=1 

در تصویر پائین از تابع IIF استفاده شده تا اگر عددی از عدد دیگر بزرگترشد خروجی آن چه خواهدبود فرضا اگر 0<0 باشد N را برمیگرداند و اگر 0<1 باشد که TRUE است Y را.

با تابع REPLACE  کاراکترهای بعد ازM را استخراج کردیم یعنی 0 یا 1

می توان تابعی با نام   HandleBtnClk   نوشت و در آن لوپی ایجادکرد و تصویر اول را در نظر بگیرید

فرض کنید سه باتن با نام های M0 M1 M2 دارید باتن M1 را PRESS می کنید انتظار آن است که M0 و M1 ثابت و در موقعیت خود بمانند و باتن M2 به اندازه پراپرتی TOP خودش و 5 برابر ارتفاع باتن M0 ( در اینجا فرض شده ارتفاع باتن ها یکیست و PADDING همه صفر است و دقیقا باتن به همدیگر چسبیده اند ) به پائین و TOP جدید منتقل شود.

آرایه ای به نام (2) BTN تعریف شده که مقادیر 3 ، 5 و 1 را برای ضرب در ارتفاع یک باتن در خود ذخیره میکند فرضا اگر باتن M1 فشرده شد عدد 5 برگردانده شود و در M0.HEIGTH ضرب شود.

For i=0 To 2
Me("M" & i).Top= Me0.Top+M0.Heigth × iif(i>x,btn(x)+i,i)
Next

در لوپ بالا چنانچه M1 فشرده شود با توجه به تابع IIF در تصویر داریم 

x=1, BTN(1)=5

i>x .... 0>1 .... i=0

M0.TOP=M0.TOP+M0.HEIGTH × 0

i>x.....1>1 ....i=1

M1.TOP=M0.TOP+M0.HEIGTH × 1

i>x.....2>1....BTN(1)=5

عدد i را به() BTN اضافه کردیم چون مبدا را از M0.TOP گرفتیم 

M2.TOP=M0.TOP+M0.HEIGTH×7

اگر روی باتن M0 کلیک کنید x برابر 0 با تابع Replace ( البته این تابع را باید در تابع Val بگذارید تا عدد برگرداند ) و (0)BTN برابر 3 میشود ( عدد 3 منظور بین باتن M0 و M1 سه تا باتن فاصله بیافتد ، افتااااااد !!! )

i>x .... 0>0 .... i=0

M0.TOP=M0.TOP+M0.HEIGTH × 0

i>x.....1>0 ....BTN(0)=3

عدد i را به() BTN اضافه کردیم چون مبدا را از M0.TOP گرفتیم 

M1.TOP=M0.TOP+M0.HEIGTH × (3+1)

i>x.....2>0....BTN(0)=3

M2.TOP=M0.TOP+M0.HEIGTH×(3+2)

فقط مشکل اینجاست که اگر شما برای بار دوم و چندم روی باتن کلیک کنید چون TOP آنها در هر بار کلیک  تغییر میکند بقیه باتن ها رو به پائین و پائین تر حرکت یا انتقال داده خواهند شد 

اینجاست که می توانید متغیری تعریف کنید که پراپرتی TAG باتن را به یک تغییر دهد و چک کند چنانچه یک بودBTN(x)+i عمل نکند  آیا امکانپذیر خواهد بود؟ این یک طرح است و می توان متغیری به نام CLICKED از نوع BOOLEAN حتی تعریف کرد.

For i=0 To 2

Me("M" & i).Top= Me0.Top+M0.Heigth × iif(i>x And 

Me("M" & x).Tag=1,btn(x)+i,i)

Me("M" & i).Tag=iif(i=x And Me("M" & x).Tag=0,1,0)

Next

AND بین دو مقایسه فقط در صورتیکه دوطرف TRUE باشد TRUE است در غیر اینصورت جواب FALSE است می توانید با زدن CTRL+G و رفتن به پنجره IMMIDIATE WINDOW امتحان نمائید.

فرض کنیم TAG تمام باتن ها صفر است و برای اولین بار روی باتن M1 کلیک کرده ایم.

Me("M" & i).Top= Me0.Top+M0.Heigth × iif(i>x And 

Me("M" & x).Tag=1,btn(x)+i,i)

Me("M" & i).Tag=iif(i=x And Me("M" & x).Tag=0,1,0)

i=0 , x=1 , M1.TAG=0

i>x , 0>1=FALSE  AND M1.TAG=1 =FALSE ANS=FALSE i=0

M0.TOP=M0.TOP+M0.HEIGTH × 0

i=x , 0=1=FALSE AND M1.TAG=0=TRUE ANS=FALSE

M0.TAG=0

-----------------------------------------

i=1 ,  x=1 , M1.TAG=0

i>x , 1>1=FALSE AND M1.TAG=1=FALSE ANS=FALSE i=0

M1.TOP=M0.TOP+M0.HEIGHT × 1

i=x , 1=1=TRUE AND M1.TAG=0=TRUE ANS=TRUE

M1.TAG=1

----------------------------------------

i=2 , x=1  ,  M1.TAG=1

i>x , 2>1=TRUE AND M1.TAG=1=TRUE ANS=TRUR  BTN(x)=5

M2.TOP=M0.TOP+M0.HEIGHT × (5+2)

i=x ,  2=1=FALSE AND M1.TAG=0=FALSE ANS=FALSE

M2.TAG=0

-----------------------------------------

اگر دوباره روی M1 کلیک کنیم چه اتفاقی خواهد افتاد.

داریم 

M1.TAG=1

i=0 , x=1 , M1.TAG=1

i>x ,  0>1=FALSE AND M1.TAG=1=TRUE ANS=FALSE i=0

M0.TOP=M0.TOP+M0.HEIGHT × 0

i=x , 0=1=FALSE AND M1.TAG=0=FALSE ANS=FALSE 

M0.TAG=0

---------------------------------------------

i=1 , x=1 , M1.TAG=1

i>x ,  1>1=FALSE AND M1.TAG=1=TRUE ANS=FALSE i=1

M1.TOP=M0.TOP+M0.HEIGHT × 1

i=x , 1=1=TRUE AND M1.TAG=0=FALSE ANS=FALSE

M1.TAG=0

---------------------------------------------

i=2 , x=1 , M1.TAG=0

i>x ,  2>1=TRUE AND M1.TAG=1=FALSE ANS=FALSE i=2

M0.TOP=M0.TOP+M0.HEIGHT × 2

i=x , 2=1=FALSE AND M1.TAG=0=TRUE ANS=FALSE 

M2.TAG=0

خب طبق تصویری که در ذهن کشیده شد همراه با عملکرد توابع و عملگرهای منطقی بعد از کلیک کردن بار دوم روی باتن M1 پراپرتی TAG تمام کنترل ها به صفر تغییر پیدا نمود.

حال فرض بر این است که اگر یکبار روی باتن M1 کلیک شد و M2 به موقعیت چند برابر HEIGTH کنترل M0 لانچ یا پرتاب شد چنانچه این بار روی باتن M0 کلیک شد چه اتفاقی خواهد افتاد.

در این فرض معلومات تصویر ذهنی ما چنین خواهد بود.

M0.TAG=0

M1.TAG=1

M2.TAG=0

لوپ را ران می کنیم 

i=0 , x=0 , M0.TAG=0

i>x , 0>0=FALSE AND M0.TAG=1=FALSE ANS=FALSE i=0

M0.TOP=M0.TOP+M0.HEIGTH × 0

i=x , 0=0=TRUE AND M0.TAG=0=TRUE ANS=TRUE

M0.TAG=1

--------------------------------------------

i=1 , x=0 , M0.TAG=1

i>x , 1>0=TRUE AND M0.TAG=1=TRUE ANS=TRUE BTN(x)=3

M1.TOP=M0.TOP+M0.HEIGTH × (3+1)

i=x , 1=0=FALSE AND M0.TAG=0=FALSE ANS=FALSE

M1.TAG=0

------------------------------------------

i=2 , x=0 , M0.TAG=1

i>x , 2>0=TRUE AND M0.TAG=1=TRUE ANS=TRUE BTN(x)=3

M2.TOP=M0.TOP+M0.HEIGTH × (3+2)

i=x , 2=0=FALSE AND M0.TAG=0=FALSE ANS=FALSE

M2.TAG=0

-------------------------------------------

Public Function HandleBtnClk(C As Control)

تابع نوشته شده بالا را میتوان در رویداد کلیک باتن ها گذاشت و از این بازی شیرین که پرتاب باتن های بعدی است ، لذت برد .

aparat

CommandButton.Move method (Access)

انتقال شئ مشخص شده به مختصات تعیین شده با مقادیر آرگومان ها

expression.Move (Left, Top, Width, Height)

 آرگومان LEFT  در این متد لازم و ضروری است .

Property Set statement

نام ، آرگومان ها و کدی که بدنه یک رویه پراپرتی را تشکیل میدهد ، اعلام می کند که یک مرجع را به یک شئ تنظیم می کند.

نوشتار عبارت Property Set قسمت هایی را دارد : 

Optional : انتخابی است ،  نشان میدهد که آرگومان می تواند یا نمی تواند توسط 

Caller تامین شود.

Public : انتخابی است ، نشان میدهد که رویه Property Set قابل دسترسی است به تمام دیگر رویه ها در تمام ماژول ها (Modules) . اگر در ماژولی که حاوی عبارت Option Private است بکار برده شود رویه در خارج از پروژه ( Project ) موجود نیست. 

Private : انتخابی است ، نشان میدهد که رویه Property Set قابل دسترسی است فقط به سایر رویه ها در ماژولی که اعلام می گردد یا بیان میشود.

Static : انتخابی است ، نشان میدهد که متغیرهای لوکال رویه Property Set  بین Call ها رزرو شده اند .  Static atteibute روی متغیرهایی که خارج از رویه Property Set اعلام سا اظهار شده تاثیری ندارد ، حتی اگر آنها در رویه بکار برده شوند.

Name :  اجباریاست و انتخابی نیست !!! نام رویه Property Set 

arglist : اجباریست ، لیست متغیرهای رزرو شده که پاس داده میشوند به رویه Property Set وقتی Call  یا فراخوانی میشود.آرگومان های چندتایی با کاما جدا می شوند 

نوشتاری و قسمت های arglist : 

[ Optional ] [ ByVal | ByRef ] [ ParamArray ] varname [ ( ) ] [ As type ] [ = defaultvalue ]

OPTIONAL : مشخص میکند که آرگومان اجباری نیست اگر استفاده شود تمام آرگومان های بعدی هم باید با OPTIONAL ذکر شوند.

BYVAL : اختیاریست ، نشان میدهد که آرگومان VALUE یا عددی است 

BYREF : اختیاریست ، نشان میدهد که آرگومان توسط یک رفرنس PASS داده میشود و BYREF در ویژوال بیسیک DEFAULT  است یعنی شما استفاده نکنید BYREF در نظر میگیرد.

PARRAMARRAY : اختیاریست ، بعنوان آخرین آرگومان در ARGLIST استفاده میشود و نشان میدهد که آرگومان نهایی یک آرایه انتخابی از اجزاء VARIANT است کلمه PARAMARRAY به شما این اجازه را میدهد که یک شماره اختیاری از آرگومان ها را فراهم کنید و نمی تواند با BYVAL ، BYREF یا OPTIONAL بکار رود.

VARNAME : اجباریست و نام متغیراست 

TYPE : انتخابیست ، DATA TYPE است که بین رویه ها استفاده میشود  مثل BYTE BOOLEAN SINGLE DOUBLE STRING 

یادداشت : 

هر عبارت PROPERTY SET بایستی با یک آرگومان مشخص شود 

یک parameter array می تواند برای  عبور یا پاس دادن آرایه ای از آرگومان ها استفاد شود . شما نباید تعداد اجزاء در آرایه را بدانید زمانیکه رویه را تعیین می کنید 

استفاد کلمه ParamArray برای مشخص کردن کردن یک parameter array . آرایه می بایست بعنوان آرایه ای از دیتا تایپ Variant اعلام شود , و می بایست در آخرین آرگومان در رویه مشخص گردد.

مثال زیر نمایش میدهد که چگونه یک رویه با parameter array تعیین می گردد .

Sub AnyNumberArgs(strName As String, ParamArray intScores() As Variant)

Dim intI As Integer 

 Debug.Print strName; " Scores" 

' Use UBound function to determine upper limit of array. For intI = 0 To UBound(intScores()) 

 Debug.Print " "; intScores(intI) 

Next intI 

End Sub

ومثال زیر هم مشخص میکند که چطور رویه را call یا فراخوانی بنمائید.

AnyNumberArgs "Jamie", 10, 26, 32, 15, 22, 24, 16 
 
AnyNumberArgs "Kelly", "High", "Low", "Average", "High" 

ParamArray : 

کلمه ParamArray اجازه میدهد به شما که تعداد داینامیک یا پو یایی از آرگومانها را قبول یا پذیرش کنید

کلمه ParamArray اختصار parameter array است

بجای بکارگیری تعدادزیادی از پارامترهای انتخابی  استفاده از parameter array می تواند کمک خوبی باشد.

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

با ByValue و ByRef نمی تواند همراه باشد!

باید با دیتا تایپ Variant اعلام و اظهار گردد

پایه آن Zero است یعنی از صفر شروع میشود intl در مثال بالا

 Parameter array می تواند حاوی دیتا تایپ های مختلفی باشد 

array of array

Public Sub Procedure_Five(ByVal iConstant As Integer, _ 
ParamArray aArgumentsArray() As Variant) 
Dim icount As Integer 
Dim vArg As Variant 
   For icount = 0 To UBound(aArgumentsArray(0)) 
      vArg = aArgumentsArray(0)(icount) 
      Debug.Print vArg 
   Next icount 
End Sub 

Public Sub RunThis_Five() 
    Call Procedure_Five(100, Array("one","two")) 
End Sub

Public Function MySUM(ParamArray args())
    For Each arg In args
        MySUM = MySUM + arg
    Next arg
End Function

در کد زیر از paramarray استفاده شده اگر پارامترهای داخل آن Null نباشد جواب یا برگشتی تابع خواهد بود 

Public Function Coalesce(ParamArray arguments()) As Variant

Dim retVal As Variant

Dim i As Long

retVal = Null For i = LBound(arguments) To UBound(arguments) 

If Not IsNull(arguments(i)) Then 

retVal = arguments(i) 

Exit For

End If

Next i 

Coalesce = retVal

End Function

Public Sub testCoalesce()

Dim dummy As Variant

dummy = Coalesce(Null, Null, "ABC")

dummy = Coalesce(Null, Null, "ABC", 123)

dummy = Coalesce(Null, Null, "ABC", 123, 42.23)

dummy = Coalesce(Null, Null, "ABC", 123, 42.23, #12/15/2018#)

End Sub

Property Let : مقدار پراپرتی را تنظیم میکند

A procedure that sets the value of a property.

Property Get : مقدار پراپرتی را بر می گرداند

A procedure that returns the value a property.

Property Set :رفرنسی به یک شئ را تنظیم می نماید

A procedure that sets a reference to an object.

Public Property Get NewEmployee() As Variant

NewEmployee = employee

End Property

Public Property Set NewEmployee(ByVal vNewValue As Employee)

employee = vNewValue

End Property

Dim CurrentColor As Integer 

Const BLACK = 0, RED = 1, GREEN = 2, BLUE = 3 

' Returns the current color of the pen as a string. 

Property Get PenColor() As String 

 Select Case CurrentColor 

 Case RED 

 PenColor = "Red" 

 Case GREEN 

 PenColor = "Green" 

 Case BLUE 

 PenColor = "Blue" 

 End Select 

End Property 

' The following code gets the color of the pen 

' calling the Property Get procedure. 

ColorName = PenColor

ساخت Class در اکسس

کلاسی با نام AppForm ایجاد شده برای اینکه یکسری خاصیت ها در فرم تنظیم شود 

AppForm class.

Option Compare Database 

Option Explicit

Private WithEvents frm As Access.Form

Public Sub SetAttributes(ByRef param_frm As Form)

Set frm = param_frm 

With frm ' some general form attributes

.Caption =ThisApp.Name

.NavigationButtons = False

.ScrollBars = 0

.Moveable = True 

.ControlBox = False 

.RecordSelectors = False 

End With

Set frm = Nothing

End Sub ' frm_Open

In Every Form 

Option Compare Database

Option Explicit

بعد از ایجاد کلاس در هر فرمی ازکدهای زیر استفاده میشود کلاس با نام AppForm و کدهای بالا ایجاد شده که یک رویه با نام SetAttributes در رویداد Open هر فرم تنظیمات را انجام میدهد.زمانی استفاده میشود که چندین فرم دارید و میخواهید تنظیمات یکسانی روی آنها انجام شود.

Private ThisForm As New AppForm

Private Sub Form_Open(Cancel As Integer)

ThisForm.SetAttributes Me 

End Sub

باز شدن کمبو باکس زمان انتقال فوکس

when the user goes to a new control it will run the code and dropdown if it's a combo box

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

زمانیکه کاربر به کنترل جدیدی میرود کد کار خواهد کرد و اگر کمبو باکس باشد DropDown میشود ( البته طبق گفته ی بالا در کنترل ها لوپ زده و گفته اگر ControlType کنترل acComboBox باشه DropDown انجام شود  ) که در رویداد GotFocus  هر کنترلی که کمبو باکس است می توانید به یک رویه کلی در همون آبجکت فرم ارجاع دهید.

Sub ControlName_GotFocus

DrowDownComboBox comboControl

End Sub

Public Sub DropDownComboBox(ComboControl As ComboBox)

  ComboControl.Dropdown

End Sub