تابع RND

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

Logical Operator

:Table

Orders

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

:Query

Qr_Orders

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

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

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

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

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

.True And False.   Or .True And True.

False Or True 

True =-1

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

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

.False And True. Or .False And False.

False Or False 

Flase=0

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

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

.False And False. Or .True And False.

False Or False 

Flase=0

:Query

Qr_Orders

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

مثال دوم  :

:Query

Copy Of Qr_Orders

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

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

(" state/province]="il

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

رکورد یک

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

.True And .False Or True 

True And True

True=-1

رکورد دو

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

.True And .True Or False 

True And True

True=-1

رکورد 6 

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

.True And .False Or False 

True And False

False=0

:Query

Copy Of Qr_Orders

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

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

("state/province]="ny

رکورد اول 

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

True Or False. And False.

True And False

False=0

رکورد دوم 

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

True Or False. And True.

True And True

True=-1

Copy Of Qr_Orders

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

Filter With CheckBoxes

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

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

Null

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

True

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

True

( null or ( True or true?

True

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

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

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

100

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

Null

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

Null

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

False

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

True

( null or ( False or true?

True

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

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

100

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

103

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

100 

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

False

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

False

False or False?

False

false Or 100?

 100 

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

Event OnChange For TextBox

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

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

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

Me.Requery 

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

Me.text5.SetFocus 

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

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

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

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

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

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

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

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

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

 " " & Me.text5=Me.text5

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

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

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

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

!  Note

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

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

RowCounter

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

Static col  As New Collection

Static strGroup As String

  On Error GoTo Err_RowCounter

If booReset=True Or strGroup <> strGroupKey Then

    Set col = Nothing

    strGroup = strGroupKey

  Else

    col.Add col.Count + 1, strKey

  End If

  

  (RowCounter = col(strKey

End Function 

Details

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




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

Filter a query based on data entered in a text box

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

نمونه ماکرو 

OpenTextFile Method

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

,object.OpenTextFile (filename,iomode,create

  format

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

 read from this file '

ForAppending=8


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

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

TextStream

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

Methods of the TextStream Object

Property	Description
Close	Closes an open TextStream file.
Read	Reads a specified number of characters from a TextStream file and returns the resulting string.
ReadAll	Reads an entire TextStream file and returns the resulting string.
ReadLine	Reads an entire line (up to, but not including, the newline character) from a TextStream file and returns the resulting string.
Skip	Skips a specified number of characters when reading a TextStream file.
SkipLine	Skips the next line when reading a TextStream file.
Write	Writes a specified string to a TextStream file.
WriteLine	Writes a specified string and newline character to a TextStream file.
WriteBlankLines	Writes a specified number of newline characters to a TextStream file.

Properties of the TextStream Object

Property	Description
AtEndOfLine	A Boolean indicating whether or not the file pointer is at the end of a line in the text file (used when reading character by character).
AtEndOfStream	A Boolean indicating whether or not the file pointer is at the end of file (used when reading line by line).
Column	The column number of the current character position in a TextStream file.
Line	The current line number in a TextStream file.

FileSystemObject

("Set fso=CreateObject("Scripting.FileSystemObject

    (Set fld = fso.GetFolder(strSourcePath

For Each sfldr in fld.Subfolders

Debug.Print sfldr.Name

Next

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

Set fls=fld.Files

 For Each f In  fls

Debug.Print f.Name

Next

Method	Description
CopyFile	Used to copy an existing file.
CopyFolder	Used to copy an existing folder.
CreateFolder	Used to create a folder.
CreateTextFile	Used to create a text file.
DeleteFile	Used to delete a file.
DeleteFolder	Used to delete a folder.
DriveExists	Used to determine whether a drive exists.
FileExists	Used to determine whether a file exists.
FolderExists	Used to determine whether a folder exists.
GetAbsolutePathName	Used to return the full path name.
GetDrive	Used to return a specified drive.
GetDriveName	Used to return the drive name.
GetFile	Used to return a specified file.
GetFileName	Used to return the file name.
GetFolder	Used to return a specified folder.
GetParentFolderName	Used to return the name of the parent folder.
GetTempName	Used to create and return a string representing a file name.
MoveFile	Used to move a file.
MoveFolder	Used to move a folder.
OpenTextFile	Used to open an existing text file

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

For Each FileItem In SourceFolder.Files

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

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

("Set xls=CreateObject("Excel.Application

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

("Set xlsht=Wbk.WorkSheets("Sheet1

Dim db As Dao.DataBase

Dim rst As Dao.RecordSet

xlsht.Range("A2").Select

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

rst.AddNew

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

rst.Update

rst.Close

Set rst=Nothing

Set db=Nothing

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

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

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

:the expression to make the range 1..100

1 + Int( 100 * Rnd())

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

The general expression to generate a random integer

: in a particular range is

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

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

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

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

Trur Or False 

Generating a random value of True or False is also

: easy

Rnd() > 0.5

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

()Private Sub CmdClear_Click

""=  Me.lstData.RowSource 

End Sub

()Private Sub Form_Timer

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

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

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

End Sub

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

Private Sub GroupFooter0_Format(Cancel As Integer, FormatCount As Integer)

' note that this is linked to the Format event of the Footer0

If Me!MyCount > 1 Then

GroupFooter0.Visible = True
Else
GroupFooter0.Visible= False
End If
End Sub

ERROR 3021 : No current record

With frm.RecordsetClone

        Bookmark = frm.Bookmark.

        X = .AbsolutePosition + 1

    End With

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

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

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

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

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

mdlRownumbers Module

Private lngRowNumber As Long

Private colPrimaryKeys As VBA.Collection

Public Function ResetRowNumber() As Boolean

Set colPrimaryKeys = New VBA.Collection

lngRowNumber = 0

ResetRowNumber = True

End Function

Public Function RowNumber(UniqueKeyVariant As Variant) As Long

Dim lngTemp As Long

On Error Resume Next

lngTemp = colPrimaryKeys(CStr(UniqueKeyVariant))

If Err.Number Then

lngRowNumber = lngRowNumber + 1

colPrimaryKeys.Add lngRowNumber, CStr(UniqueKeyVariant)

lngTemp = lngRowNumber

End If

RowNumber = lngTemp

End Function

تابع GetTickCount

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

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

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

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

در مثال زیر دیتاهایی  در جدولی بنام Table1 رکورد شده و فیلد سوم هر گروه (  Line+Joint ) بصورت سورت id پشت سر هم به جدول Table2 ارسال و در آنجا ذخیره میشود 

با کوئری نمی توان اینکار را انجام داد در نتیجه مجبوریم از Recordset استفاده کنیم.

1-نوشتن ساختار Sql جهت سورت نمودن  رکوردهای جدول Table1 آنهم به این علت که رکوردهای هر گروه بصورت پراکنده در جدول ثبت شده.

"sSql="Select * From Table1 Order By Line,Joint,id

2-ایجاد کردن در حافظه ی موقت و باز کردن رکوردست در حالت SnapShot 

(Set rst=db.OpenRecordSet(sSql,dbOpenSnapShot

3-رفتن به اولین رکورد و ذخیره کردن داده های Line Joint Re از Table1 در متغیرهای st1 st2 st3 

rst.MoveFirst

st1=rst!Line

st2=rst!joint

st3=rst!re

4-رفتن به رکورد بعدی که حتما نوشتن این قطعه الزامیست 

rst.MoveNext

در این مرحله در رکوردست لوپ زده میشود تا زمانیکه به انتهای آن برسد (EOF)   داخل لوپ اگر st1=rst!Line و st2=rst!joint  بود بایستی ستون re در هر تعدادکه بود پشت سر هم الصاق شوند و در متغیر st3 ذخیره شود

st3=st3 & ", " & rst!re

در غیر اینصورت دیتای ذخیره شده در این سه متغیر یعنی st1 st2 st3 در جدول Table2 اضافه یا اپند شود با ساختار Sql و استفاده از Insert Into و در نهایت قبل از بسته شدن if دوباره دیتاهای Line joint re در این متغیرها ذخیره گردند و به رکورد بعدی با rst.MoveNext این حلقه ادامه پیدا میکند در آخر یک رکورد در Table2 اپند نمی شود بعلت MoveNext اول که بعد از بستن Loop باید دوباره آن Sql که برای اپند کردن نوشته شده دوباره اجرا شود برای سرعت کار اپند کردن حتما از متد Database.Execute استفاده کنید و نه از Docmd.RunSql چرا که در رکوردهای حجیم مدت زمان بیشتری طول خواهد کشید البته نوشتن ساختار درست Sql هم باعث بالارفتن تقریبی سرعت خواهد شد .

 "('" & sSql="Insert Into Table2(Line,joint,re) Values('" & st1 & "','" & st2  & "','" & st3 

db.Execute sSql

حال شرح کد بالا به زبان ساده فرض کنید سورت شده ی جدول ۱ که با ساختار زبان sql در رکوردست باز شده ( مرحله ۲ )  طبق زیر باشد 

Line   joint   re 

A1          1      Rs

A1          1     Rt

A2          4     r1

 st1=A1

st2=1

st3=Rs

از رکورد بعدی شروع میکند اگر نکند در آخر جواب میشود A1  1  rsrsrt یعنی Rs دوبار تکرار میشود  

MoveNext

Do While.......Loop 

if A1=A1 And 1=1Then 

st3=st3 & ", " & Rs

در نهایت st3 در اینجا با رفتن به رکوردهای بعد در گروه A1 1 طبق MoveNext در انتهای Loop  میشود st3=RsRt 

Else

Append Query 

st1=A2

st2=4

st3=r1

End if 

MoveNext

چون در قبل از لوپ MoveNext قید شده در نتیجه به انتهای فایل میرسد و باید یک کوئری اپند دیگر برای St1=A2 st2=4 ,st3=r1 نوشت 

(Database.Execute method (DAO

اجرای Action Query یا Sql و سرعتش از Docmd.runsql بیشتر است و فقط روی Action Query ها قابل اجراست در غیر اینصورت ارور خواهد داد 

اکشن کوئری مثل اپند ، دیلیت یا کوئری آپدیت 

اگر با رکوردست کار می کنید و لوپ می زنید که کاری انجام شود در حجم زیادی از رکوردها برای سرعت انجام کار از این روش استفاده بنمائید و اگربعد از آن  dbfailonerror هم استفاده کنید از ارور صرفنظر میکند و فرآیند ادامه پیدا میکند 

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

مرتب سازی اعداد در اکسس با استفاده از VBA

ساده ترین روش مرتب نمودن اعداد بصورت صعودی 

البته وقتی سورس اعداد در جدول یا کوئری باشد  میشود در Query Builder ،  عملیات Sort را انجام داد و در لیست باکس بدون هیچ دردسری مرتب سازی را مشاهده نمود ولی  هدف یادگیری زبان VBA است وگرنه نیازی به اینکاری که انجام دادیم نیست 

برای سورت یا مرتب سازی اعداد بصورت صعودی یا ASC از روش جایگزینی دو عدد مقایسه شده استفاده شده که اگر بزرگتر بود با عدد کوچکتر در آرایه جابجا شوند فرضا  اعدا  8,3,12 مشهود است نتیجه بصورت مرتب سازی صعودی می بایست 3,8,12 باشد

(Dim A(2

A(0)=8

A(1)=3

A(2)=12

عدد اول را از آرایه میگیریم 

N=A(0)=8

یک لوپ میزنیم 

 For i=0 To 2....Next

در لوپ اگر N از( A(i بزرگتر بود جای آنها عوض میشود در مثال بالا N=8 از A(i)=3 بزرگتر است در نتیجه A(0)=3 و A(1)=12 میشود و در آخر  A(i)= N در غیراینصورت ( N=A(i

8,3,12

3,8,12

یا فرضا مرتب سازی صعودی اعداد 2,6,4,0,1  و مراحل انجام شده توسط کد 

0:2,6,4,0,1

1:2,4,0,1,6

2:2,0,1,4,6

3:0,1,2,4,6

4:0,1,2,4,6

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

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

For j=0 To 2 

(Debug.Print A(j

Next

روش های پیچیده دیگری هم در اینترنت وجود دارد  ولی ساده ترین روش که قابل فهم باشد مانند توضیحات ذکر شده در بالا است.

Split text In 3 Boxes

مثالی در جدا کردن تکست ها با نشانه ی فاصله یا Delimiter از یک فروم خارجی جهت استفاده 

Extract Number From Text

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

Function GetNumber(ByVal pStr As String) As Long
Dim intLen  As Integer
Dim n       As Integer
    pStr = Trim(pStr) 'removes leading & trending spaces
    intLen = Len(pStr) 'stores original length
    n = 1 'consider this a counter & position marker
    If pStr = "" Or IsNull(pStr) Or intLen = 0 Then Exit Function 'validate we didn't get passed an empty/null string
    Do
        If IsNumeric(Mid(pStr, n, 1)) Then 'check if that single character is a number
            GetNumber = GetNumber & Mid(pStr, n, 1) 'if it is add to existing ones if any
    Loop Until intLen = (n - 1) 'go until we processed all characters. The reason we have to do n-1 is that Len starts at 0 & we told n to start at 1
            n = n + 1 'add to counter so we know to go to next character on the next pass/loop
        Else
            n = n + 1 'it wasn't a number, add to counter so we know to skip it
End Function 'if no numbers function will return default value of data type, in our case long would be 0
        End If

All cred

Dynamic search filter

استفاده از FilterOn و رویداد KeyUp برای فیلتر در FirstName یا LastName هر کدام بود فیلترشود

در کد زیر که از سایت خارجی استخراج شده و در رویداد KeyUp استفاده شده نتیجه آن در شکل بعد از کد نمایان گردیده  بطوریکه با فشردن هر کلید چنانچه در یکی از فیلدهای First یا Last بود دیتا گرید فیلتر میشود ، در شکل Tom تایپ شده و نهایتا هر رشته ای از این دو فیلد که در آن Tom دارد فیلتر شده بطور خودکار کار میکند یعنی وقتی T تایپ شود تمام رشته هایی در این دو فیلد که شامل T میشوند خواه در اول باشد یا آخر یا وسط فیلترمیشود بعد از تایپ o تمام رشته هایی که To دارند فیلتر میشوند و الی آخر 

If Len(txtNameFilter.Text) > 0 Then
   filterText = txtNameFilter.Text
   Me.Form.Filter = "[Contacts]![first_name] LIKE  
 filterText]  & "*' OR [Contacts]![last_name] & "*'
  "'*" & LIKE '*" & filterText 
   Me.FilterOn = True
  Retain filter text in search box after refresh'
   txtNameFilter.Text = filterText
   (txtNameFilter.SelStart = Len(txtNameFilter.Text 
Else
   Remove filter'
"" =  Me.Filter 
   Me.FilterOn = False
   txtNameFilter.SetFocus
End If

	
		

جدا کردن ارقام در VBA

فرض کنید رشته  x1y135 موجود است و میخواهید ارقام را از آن جدا کنید ( خروجی 1135 شود ) 

اولین کار زدن لوپ ( For.....Next ) در طول آن رشته است ( تابع Len ) و  استفاده از تابع MID برای نمایش کاراکترو اینکه در همان کاراکتر مشخص کنید اگر رقم ( Digit ) بود در متغیری مثل s ذخیره شود 

%Dim i

$Dim s

(For i=1 To Len(txt

(Select Case MID(txt,i,1

Case 0 To 9 

(1, s=s & MID(txt,i

End Select

Next

Msgbox s 

مورد بالا از سایت آفیس اقتباس شده البته روش های دیگری غیر از Select Case هم وجود دارد .

از IsNumeric هم میشود استفاده کرد و اگر نتیجه ی MID نامبر بود در یک متغیر ذخیره نماید