تغییر رنگ حروف تک به تک بصورت رندوم فقط در لیبل

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

مثالی از رویداد تایمر فرم

فرض کنید باتنی دارید که بعد از تایپ حروفی در تکست باکس کار فیلتر یا جستجو را انجام داده و در صورت یافتن یا ... پیامی را در لیبلی که Visible نیست نمایان میکند و مدت معینی با TimeInterval لیبل به حالت چشمک زن در می آید و بعد از فوکس کردن به تکست باکس دوباره لیبل Hide میشود.

در رویداد کلیک باتن TimeInterval را تنظیم کنید فرضا به 300 میلی ثانیه .... در ضمن نام آبجکت لیبل lblMsg است .

Private Sub Form_Timer()
L = L + 1
Select Case L
    Case 1, 3, 5, 7, 9, 11, 13, 15, 17
        Me.lblMsg.Visible = True
        Me.lblMsg.Visible = False
    Case 2, 4, 6, 8, 10, 12, 14, 16, 18
    Case 19
       Me.TimerInterval = 0
       Me.lblMsg.forecolor = forecolor
       Me.lblMsg.Visible = True
End Select
End Sub
Private Sub TxtSearch_GotFocus()
     Me.lblMsg.Visible = False
End Sub

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

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

حرکت رشته از راست به چت کاراکتر به کاراکتر در لیبل

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

( Select Query ( Access برای مشاهده محتویات نیازمند واریز مبلغ مورد نظر است

این مطلب توسط نویسنده‌اش رمزگذاری شده است و برای مشاهده‌ی آن احتیاج به وارد کردن رمز عبور دارید.

(Editing Record issues in Access / SQL (Write Conflict

زمان بردن جداول به Sql حتما چک کنید فیلدهایی که پرایمری کی نیست و نباید Null باشد  پر شده باشد وگرنه خطا میدهد  

Int

Bigint

Is there a bit field in your table? i.e. ‘1 or 0 ‘ or ‘yes or no’?

I’ve seen Access kick back those errors on linked tables with a bit field and no default value set.

You might want to add a timestamp field to the table as that seems to often resolve this problem.

Another possibility is that you are editing a record in a form and the form is dirty (i.e., edits not saved) and you run code that uses DAO or ADO to run SQL to update the same record. Jet sees that as 2 users editing the same record. Try to force a save before running the SQL update:

If Me.Dirty Then

Me.Dirty = False

End If

[run SQL update here]

When a record is saved, Microsoft Access sets the Dirty property to False. When a user makes changes to a record, the property is set to True.

زمان تغییر True و ذخیره False 

Form.Dirty event (Access)  : 

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

The Dirty event occurs when the contents of the specified control changes.

نوشتاری : 

Syntax : 

expression.Dirty (Cancel)

این تنظیم تعیین می کند آیا رخ می دهد یا خیر ، تنظیم آرگومان Cancel به True

Cancel : 

The setting determines if the Dirty event occurs. Setting the Cancel argument to True

MultiSelection Microsoft Access

ComboBox.ItemData property (Access) :

expression.ItemData (Index)

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

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

باید پراپرتی MultiSelect لیست یاکس به Simple یا Extended تنظیم شود تا کاربر قادر به انتخاب بیشتر از یک ردیف باشد.

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

ListBox.ItemsSelected property (Access) :

مجموعه ItemSelected دو پراپرتی Count و Item دارد بدون داشتن هیچ متدی البته

Dim frm As Form, ctl As Control

Dim varItm As Variant

Set frm = Forms!Contacts

Set ctl = frm!Names

For Each varItm In ctl.ItemsSelected

Debug.Print ctl.ItemData(varItm)

Next varItm

مثال بالا مقدار باند کالمن هر ردیف انتخاب شده را چاپ میکند در پنجره immidiate window

مثال زیر باز شدن گزارش با شرط خاصی مشخص شده، یک لیست MultiSelection است و چنانچه کاربر  یک یا چند داده را انتخاب کند و باتن cmdOpenReport را بفشارد گزارش حاوی داده ها ی گرفته شده باز میشود.

Private Sub cmdOpenReport_Click()

    Dim varItem As Variant

    Dim strEmployeeIDList As String

    Dim strCriteria As String

    Dim ctrl As Control    

    Set ctrl = Me.lstEmployees    

با پراپرتی کانت چک میکند که حداقل یک گزینه از لیست باکس انتخاب شده باشد.

    If ctrl.ItemsSelected.Count > 0 Then

در کد For Each....Next  داده آیتم یا آیتم های انتخاب شده را با پراپرتی ItemData ی کنترل میگیرد ، بین آنها کاما گذاشته و به متغیر strEmployerIDList میدهد

        For Each varItem In ctrl.ItemsSelected

            strEmployeeIDList = strEmployeeIDList & "," & ctrl.ItemData(varItem)

        Next varItem

      چون یک کاما قبل از اولین آیدی گرفته شده ( متغیر)  قرار می گیرد با تابع Mid گفته که عبارت بعد از کاما در متغیر قرار گیرد در نتیجه آن کاما حذف میشود.

        ' remove leading comma

        strEmployeeIDList = Mid(strEmployeeIDList, 2)     

حال نوبت به نوشتن شرط یا Criteria است که در  آرگومان WhereCondition  قرار داده شده  in هم کلمه ای است رزرو شده که در عبارات sql استفاده میشود و بیان نموده که strEmployeeIDList هایی که در فیلد EmployeeID ( دیتا تایپ نامبر است ) موجود است فهرست شوند .... چون ID نامبراست احتیاجی نیست که بین هر داده گرفته شده کوتیشن قرار گیرد ولی اگر دیتا تایپ فیلد تکست بود می بایست بین هر داده ای که از لیست باکس گرفته میشود غیر از همرا بودن با کاما ، تک کوتیشن نیز در ابتدا و انتهای آن قرار گیرد.

        strCriteria = "EmployeeID In(" & strEmployeeIDList & ")"

در کد زیر دستور باز شدن گزارش rptEmployees با چشم انداز Preview و شرط strCriteria داده شدس.

        DoCmd.OpenReport "rptEmployees", _

            View:=acViewPreview, _

            WhereCondition:=strCriteria

    Else

اگر هیچ آیتمی در لیست باکس انتخاب نشده باشد پیغامی را با Msgbox رایز میکند با پرامپت هیچ کارمندی انتخاب نشده.

        MsgBox "No employees selected", vbInformation, "Warning"

    End If

   

End Sub

expression.Column (Index, Row)

پراپرتی کالمن در آبجکت کمبو و لیست باکس که index اشاره به ستون مورد نظر دارد و Row هم اشاره به ردیف و از صفر شروع میشوند. فرضا شما میخواهید داده ستون دو و ردیف سوم را بگیرید.

.Column(1,2)

زمانیکه پراپرتی MultiSelect کنترل لیست باکس به None تنظیم شود فقط یک آیتم می تواند انتخاب شود و پراپرتی Selected می تواند به True تنظیم شود.وقتی پراپرتی MultiSelect کنترل لیست باکسی به Simple یا Extended تنظیم شود هر کدام یا تمام آیتم های انتخاب شده می تواند پراپرتی Selected برابر True خودش را داشته باشد. پس مشخص شد با Selected می توانید مشخص کنید کدام آیتم یا آیتم ها Select شده اگر True باشد انتخاب میشود و اگر به False تنظیم شود از حالت انتخاب در می آید.

لیست باکس چند انتخابی یا Multi-Selection باند شده به فیلدی همیشه دارای پراپرتی Value مساوی با Null است . می توان از پراپرتی Selected یا مجموعه ItemSelected برای بازیابی اطلاعات آیتم هایی که انتخاب شده اند ، استفاده نمود.

 عبارت زیر پنجمین آیتم در لیست را انتخاب ( Select ) می نماید

نام کنترل لیست باکس در اینجا ListBox1 است

 Me!Listbox1.Selected(4)=True

ComboBox.LimitToList property (Access) :

از پراپرتی LimitToList برای محدود کردن مقادیر کمبو باکس به آیتم های لیست شده استفاده میشود یعنی اگر به True تنظیم شود اگر مقداری در تکست باکس کمبو تایپ شود و در لیست نباشد زمان Enter و از دست دادن فوکس خطایی را نمایش میدهد که آیتم در لیست نیست.

Forms("Order Entry").Controls("States").LimitToList = True 

اگر بخواهید پیغام خودتان را نشان دهد در رویداد NotInList می توانید Response را مساوی صفر و پیام مورد نظرتان را در Msgbox قرار دهید

ComboBox.ListCount property (Access) :

تعیین تعداد ردیف های لیست باکس قسمتی از کمبو باکس ( کمبو باکس همانطور که در یادداشت های دیگر گفته شده یک قسمت تکست باکس و یک قسمت DropDown دارد.

اگر  پراپرتی ColumnHeads به True تنظیم شود این ردیف هم اضافه میشود یعنی ایندکس آن صفر است

ComboBox.ListRows property (Access) :

برای تنظیم حداکثر تعداد ردیف هایی که در لیست باکس قسمت کمبو باکس نمایش داده شود کاربرد دارد.

ComboBox.Locked property (Access) :

پراپرتی Locked مشخص میکند که می توان داده را در کنترلی در فرم ویرایش کرد.دیفالت True است

و این تنظیم اجازه ویرایش ، حذف و اضافه کردن داده را می دهد.

ComboBox.ListIndex property (Access) : 

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

مقدار پراپرتی ListIndex با تنظیم پراپرتی BoundColumn به صفر در دسترس است. اگر پراپرتی BoundColumn مقدار صفر بگیرد فیلدی که به کمبو یا لیست باکس باند شده حاوی همان مقداری خواهد شد که پراپزتی ListIndex تنظیم شده.

Here is the code to take data from a list box to a table...

Code:

کد زیر برای بردن داده از یک لیست باکس به یک جدول  و از کوئری Append استفاده شده البته Sql آن .

Private Sub Command14_Click()

Dim varName As Variant

Dim varItem As Variant

Dim strSQL As String

Dim undSQL As String

Dim CmbValue As String 

CmbValue = Me.Combo0.Value 

With Me.List9 

For Each varItem In .ItemsSelected

در عبارت Sql زیر در Insert into نام جدول و بعد داخل پرانتز نام فیلدهایی که باید داده به آن اضافه شوند و بعد Values و داخل پرانتز داده ها برای داده های فیلد از نوع دیتا تایپ تکست از تک کوتیشن در ابتدا و انتهای متغیر استفاده می شود . به پرانتزها و فواصل توجه کنید وگرنه خطای Syntax یا نوشتاری خواهید گرفت.

strSQL = "INSERT INTO tlbTempRecordset (UnderwriterName, ST_CODE) VALUES ('" & .Column(0) & "','" & .ItemData(varItem) & "');"

DoCmd.RunSQL (strSQL)

عبارت زیر حتما باید اعمال گردد وگرنه مقادیر تکرار و تکرار میشوند چون در لوپ هستیم   و اتومات Reset  نمی شود عزیزان

strSQL = ""

Next varItem 

End With 

Me.List9.Value = Null 

End Sub

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

is

Recordset.AbsoluePosition

Sets or returns the relative record number of a Recordset object's current record.

شماره رکورد مرتبط با  رکورد جاری شئ رکورد ست را بر میگرداند و Zero Based است یعنی از صفر شروع میشود چون در فرم کانتینیوس نمی توان ردیف ترتیبی گذاشت برخلاف آبجکت گزارش در نتیجه برای شماره دادن به رکوردها از AbsolutePosition استفاده می نمایند البته با استفاده از BookMark که می بایست BookMark فرم و رکوردست منطبق بشوند و بعد کار اضافه کردن را انجام داد.

یادآوری میشود : 

مقدار ویژگی AbsolutePosition از صفر شروع میشود تا رکورد کانت منهای یک ، اگر مقدار این پراپرتی مساوی یا  بالاتر از رکوردهای پرشده باشد خطا میدهد با بررسی پراپرتی RecordCount می توانید تعداد رکوردهای پرشده در شئ رکوردست را تعیین بنمائید. حداکثر تنظیم مجاز پراپرتی AbsolutePosition مقدار پراپرتی RecordCount منهای یک است.

Recordset.Bookmark property (DAO)

زمان ساختن یا باز کردن شئ رکوردست هرکدام از رکوردها یک بوک مارک یونیک یا واحدی را دارد و میتوان بوک مارک را برای رکورد جاری با تخصیص دادن مقدار این پراپرتی به متغیری ذخیره کرد.برای بازگشت سریع به آن رکورد در هر زمان بعد از ارکن به رکورد دیگری ،  پراپرتی بوک مارک شئ رکوردست به مقدار متغیر تنظیم میشود .

اگر این پراپرتی به مقدار رکورد حذفی تنظیم شود خطا یی حادث میگردد.

مقدار پراپرتی BookMark مشابه record number نیست اشتباه نشود.

Form.Bookmark property (Access)

می توان پراپرتی BookMark را با فرم هایی برای تنظیم بوک مارکی که بصورت یونیک رکورد خاصی را در جدول یا کوئری  تحت فرم مشخص میکند بکار برد.

بوک مارک ها با رکوردهایی که نشان می دهند ذخیره نمی شوند ، فقط در حالی که فرم باز است معتبر هستند. آنها هر بار که یک فرم Bound شده  باز می شود ، توسط Microsoft Access دوباره ایجاد می شوند.

پس زمانیکه فرم کانتینیوس که به جدول یا کوئری متصل است  یا با عبارت SQL دیتا می گیرد  باز میشود رکوردها دارای بوک مارک یونیک  و واحدی هستند یا در رکورد ست هر بار که تنظیم میشود بوک مارک جدیدی به ِآن تخصیص داده خواهد شد . اگر رکوردی حذف شود و به بوک مارک مقداری تخصیص داده شود ( در همان زمان حذف )  خطا ایجاد میشود.

TEXTBOX CONTROLNAME :

ROWTEXT

IN CONTROLSOURCE  PROPERTY : 

=FORMROWNUMBER(ME)

'EOF  POSITION AFTER LAST RECORD

DIM FRM AS FORM

DIM RS AS DAO.RECORDSET

SET FRM=ME.RECORDSETCLONE

RS.MOVELAST : RS MOVEFIRST

'ON ERTOR RESUME NEXT

IF NOT (RS.BOF OR RS.EOF) THEN

RS.BOOKMARK=FRM.BOOKMARK

FORMROWNUMBER=RS ABSOLUEPOSITION+1

END IF 

SET RS=NOTHING

I HOPE  TO WRITE THE CODE CORRECTLY 

VARBOOKMARK  IS  A VARIABLE 

VARBOOKMARK AS VARIANT

RS.MOVELAST

VARBOOKMARK=RS.BOOKMARK

DEBUG.PRINT  ISEMPTY(VARBOOKMARK)

SN: DCount("*","TableName","[ID]<=" & [ID])

Option Value

یادداشت : 

پراپرتی OptionValue فقط به کنترل های زیر در یک Option Group اعمال میشود.

check box

option button

toggle button

با استفاده از برگه پراپرتی کنترل می توان این پراپرتی را مقدار داد. همینطور از طریق ماکرو یا Vba مگر اینکه بصورت دستی تنظیم کنید یا مقدار  دهید.

اولین کنترلی که در Option Group قرار میگیرد مقدار یک را دارد و دومین مقدار عدد صحیح 2 و همینطور ادامه دارد چنانچه کنترل دیگری در این گروپ باشد.

پراپرتی OptionValue زمانی موجود است که کنترل داخل آپشن گروپ قرار داده شود !!! .وقتی که سه  کنترل  یاد شده در بالا در Option Group نباشد کنترل این پراپرتی را نخواهد داشت  

در عوض این چنین کنترل هایی که در Option Group قرار نمی گیرند یک پراپرتی با نام Control Source دارد و مقدار هر کنترل در صورت سلکت شدن True و عدم انتخاب False خواهد بید. 

پس چی شد دوستان طبق داکیومنت آفیس اگر شما Option Group نداشته باشید بنابراین پراپرتی Option Value هم نخواهید داشت .

فرضا در رویداد Open فرمی می نویسید که به تکست های موجود در فیلد ( کمبو باکس )   Value بدهد و در رویداد کلیک Option Group می نویسید که در صورت انتخاب هر کدام از کنترل های داخل آن Value  که در رویداد Open فرم تنظیم کرده اید را در پنجره Msgbox نمایش بدهد.

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

در رویداد Form_Open

Me.Controls("ABC").OptionValue = 15876
    
-------------------------------------

در رویداد کلیک Option Group 

    MsgBox "The ID for the selected shipper is " &  _
        Me.Controls("Ship Method Group").Value

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

برای مثال اگر کالمن ( فیلد ) دارای دو مقدار باشد Yes  و No یا On و Off استفاده از  Option Button کار انتخاب را راحت میکند.اگر کاربر یکی را انتخاب کند باعث عدم انتخاب باتن دیگر میشود پس یعنی فقط یک گزینه را می توان در یک Group انتخاب کرد و انتخاب MutiSelection نخواهید داشت مگر اینکه از Option Group استفاده نکنید و چند کنترل چک باکس تعبیه کنید 

در زیر در جدول یک فیلدی ساخته شده  با نام AccountClosed  و دیتا تایپ YesNo ، همینجا خدمت دوستان عرض میکنم از فارسی نوشتن فیلد خودداری کنید !!!. همانطور که در تصویر زیر آن می بینید پراپرتی بنام CAPTION دارد که فارسی آنرا می توانید آنجا قید کنید دابل کوتیشن هم لازم نیست بگذارید و در تصاویر دیگر نحوه انتخاب OPTION GROUP از دیزاین فرم و کشیدن آن روی فرم را نمایش داده

در جدول شما فیلد موردنظر می تواند کمبو باکس باشد بجای YesNo و چندین آیتم را شامل شود . اگر از آپشن گروپ استفاده کنید و هر کدام از رشته های داخل کمبو را به پراپرتی  OPTIONVALUE  ارتباط دهید ( احتیاجی به مقدار دادن  نیست چون خودشان مقدار می گیرند از یک تا ... همان نام را در آپشن به همان عبارت داخل کمبو تایپ کنید اسپیس ها یا فواصل بین کلمات را هم همانطور که در جدول است بگذارید) زمانیکه جدول را باز میکنید و روی فیلد کلیک میکنید VALUE را می بینید  امتحان بنمائید.

در تصویر زیر که از یکی از سایتها کپی شده   این OPTION GROUP  با استفاده از رویداد AFTER UPDATE ش سابفرم را ریکوئری می کند SUB1.REQUERY

زمانیکه روی یکی از باتن ها کلیک می کنید سابفرم می بایست با توجه به ولیوی آنها فیلتر شود فرضا اگر ALL انتخاب شود باید فیلد SALE  تیک خورده ها و نخورده ها (کلی ) در دیتاشیت لیست شود و چنانچه NO SALE انتخاب شود که ولیوی 2 دارد دیتاهایی که SALE آنها تیک نخورده نمایش داده شوند.

[Forms]![frm_Export]![optSelect]=0   ' ALL

[Forms]![frm_Export]![optSelect]=1   ' SALE

[Forms]![frm_Export]![optSelect]=2   ' NO SALE

(

 [Forms]![frm_Export]![optSelect]=0 

OR

( Sale=-1 AND [Forms]![frm_Export]![optSelect]=1) 

OR  

(Sale=FALSE AND [Forms]![frm_Export]![optSelect]=2)

)

فرض کنید دکمه ALL را SELECT یا انتخاب میکنید 

عبارت اول TRUE

عبارت دوم TRUE AND FALSE =FALSE

عبارت سوم TRUE AND FALSE=FALSE

در نتیجه TRUE OR FALSE OR FALSE میشود TRUE و تمام 

اگر دکمه SALE فشرده شود

عبارت اول FALSE چون ولیو باتن صفر نیست و یک است

عبارت دوم TRUE AND TRUE=TRUE

عبارت سوم TRUE AND FALSE = TRUE

در نتیجه FALE OR TRUE OR FALSE میشود TRUE و عبارت TRUE شده نمایش داده میشود.

اگر دکمهNO  SALE فشرده شود

عبارت اول FALSE چون ولیو باتن صفر نیست و دو است

عبارت دوم TRUE AND FALSE=FALSE

عبارت سوم TRUE AND TRUE = TRUE

در نتیجه FALSE OR FALSE OR TRUE میشود TRUE و عبارت TRUE شده نمایش داده میشود. ( عبارت سوم TRUE است )

مثال دیگر سوالی که در یک تاپیک پرسیده شده بود : 

دارم سعی میکنم فیلتری را روی ستونی به نام BILLED یک کوئری انجام میدهم که فیلد از نوع YESNO است ، با استفاده از کنترل چک باکس رو فرم.

جدول TIMESHEET دارم با اسم TBLTIMESHEET که حاوی اطلاعاتی مثل [DATE] [JOB NUMBER] [EMPLOYEE]

[HOURS] [BILLED] و غیره است  ، زمان INVOICE   برای  JOB NUMBER  مشخص گزارشی را برای یک JOB  تولید کرده ام ، سپس چک باکسی برای هر رکورد.

من کوئری ساختم از جدول براساس فرم FRMJOBTIME در آن کوئری.یک کنترل تکست باکس روی فرم قرار داده ام برای فیلتر کردن گزارش.خب ، شرط در قسمت  CRITERIA زیر ستون JOB NUMBER در کوئری  مثل این است :

[Forms]![frmJobTime]![txtJobNum]

که عالی کار میکند.

حال مشکل واقعی من اینجاست : 

من میخوام فیلتر مشابه ای را به ستون BILLED اضافه کنم با اضافه کردن کنترل چک باکس در فرم FRMJOBTIME.تیک زدن باکس به این معنیست که گزارش فقط رکوردهایی را برای JOB نمایش دهد که UNBILLED شدند و برداشتن تیک باکس باعث شود که تمام رکوردها نمایش داده شود هم BILLED هم  UNBILLED شده ها . من نمی توانم این کار را بکنم.

در واقع میخواد اگر چک باکس تیکش برداشته شد تمام رکوردها نمایش داده شود 

بالاخره دوستمون درژانویه  سال 2015  جوابش را خودش پیدا کرد .

This is where I found the answer, and here is my new SQL:

SELECT tblTimesheet.Date, tblTimesheet.[Job Number], tblTimesheet.Expense, tblTimesheet.[Miles Traveled], tblTimesheet.[Project Description], tblTimesheet.Employee, tblTimesheet.Hours, tblTimesheet.[Billed?], tblTimesheet.[Hourly Total], tblTimesheet.[Mileage Total], tblTimesheet.[GRAND TOTAL], tblTimesheet.Rate

FROM tblTimesheet

WHERE (((tblTimesheet.[Job Number]) Like " * " & [Forms]![frmJobTimeFilter]![txtJobNum] & " * ") AND ((tblTimesheet.[Billed?]) Like IIf([Forms]![frmJobTimeFilter]![chkUnbilledFilter]=True,False,"*")));

فرضا داخل کنترل  TXTJOBNUM در فرم  1201 تایپ بشود میگوید  : 

tblTimesheet.[Job Number]) Like " * " &  1201 & " * "

در اینجا چون فیلد JOB NUMBER عددیست از کوتیشن استفاده نشده اگر دیتا تایپ فیلد تکست بود میشد : 

tblTimesheet.[Job Number]) Like " '* " &  1201 & " * '"

در کل فرم فیلتر میشود و رکورد یا اگر یونیک نباشد یا پرایمری کی رکوردهایی را نمایش میدهد که JOB NUMBER برابر با 1201 باشد در قسمت بعد AND اضافه کرده و برای فیلد BILLED که صفر ( Uncheck ) یا منفی یک ( Checked ) میگیرد تابع شرطی نوشته با IIF که اگر کنترل چک باکس در فرم با نام  CHKUNBILLEDFILTER تیک خورده بود FALSE را بر گرداند یا در غیر اینصورت * را .

tblTimesheet.[Job Number]) Like " '* " &  1201 & " * '" AND  BILLED (CHECHBOX=TRUE) LIKE  FALSE 

عبارت بالا جاب نامبرهای  *1201* را می آورد که فیلد بیلد فالز باشد.یعنی تیک چک نداشته باشند.

tblTimesheet.[Job Number]) Like " '* " &  1201 & " * '" AND  BILLED (CHECHBOX=FALSE) LIKE *

عبارات بالا را تست کنید و به صحت یا عدم صحت یا کارآیی آنها پی ببرید.

Zero is used to represent false, and

 One is used to represent true. For interpretation, Zero is interpreted as false and anything non-zero is interpreted as true.

برای چک باکس و خارج شدن از فیلتر روش استفاده از عبارت در کوئری بشکل زیر است : 

Like [Forms]![frmName]![checkBox1] & "*" Or Is Null

So now, if the user does not wish to filter the result by selecting the check boxes, the result will show all data. Hopefully this will help others down the road

برای اینکه اگر یکی از دو تکست باکس txtDateFrom or txtDateTo نال باشد تمام رکوردها نشان داده شود باید غیر از Between ..... And دو تا شرط دیگر اضافه نمود ( دیتا تایپ در جدول از نوع DateTime  است )  

But you want all rows returned when either txtDateFrom or txtDateTo is Null. In that case you can add 2 conditions to your WHERE clause:

WHERE
       your_date_field Between [Forms]![Search Form]![txtDateFrom] And [Forms]![Search Form]![txtDateTo]
    OR [Forms]![Search Form]![txtDateFrom] Is Null

در صورتی فیلترکردن بین دو تاریخ  عمل نمیکند که فرمتی که در جدول ذخیره میشود و فرمت در کنترل تکست باکس مشابه نباشد!!!   فرضا "/" در جدول ذخیره نشود مثلا کسانیکه فیلد را از نوع تکست انتخاب میکنند برای تاریخ شمسی و INPUT MASK می گذارند ولی "/" در جدول فقط نمایش داده میشود و این در حالی است که "/" در تکست باکس وجود دارد و نمایشی نیست 

تبدیل ساعت از فرمت 12 ساعته به 24 ساعت در ویندوز 8

البته گفته شده اگر زبان به United Kingdom تغییر پیدا کند (آنها فرمت 24 ساعته دارند مثل کشور ما ) ساعت با فرمت 24 ساعته نمایش داده میشود.

Control Panel > Region >  Tab : Formats > Date And Time Formats > Change To HH:SS

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

برای جمع ساعات ذخیره شده در جدول اکسس می طلبد که از 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 .....