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

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

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

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

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

آرایه در اکسس



کد زیر از Access vba programming کپی شده   که به تفسیر ساده تر آن پرداختیم.



Sub modArray_StatesInAnArray()

بارگزاری فهرستی از ایالات از جدول Customers داخل آرایه ای با اندازه مشخص ... با سایز ۲۰

 Const lngArraySize = 20

 Dim lngCounter As Long

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

 Dim varAState As Variant 

 Dim strState(lngArraySize) As String

 Dim db As Database

 Set db = CurrentDb

 lngCounter = 0

 Dim rst As Recordset

متغیری که به Object یا شئ ای اشاره می کند ( بعنوان نشانگر ) را با Set  اظهار می کنند ... در کد زیر رکوردستی در حافظه موقت ایجاد شده و  درون آن داده های ستونِ [State/Province]  از جدول مشتریان ( بدون تکرار ) قرار می گیرد با شرط پر بودن این فیلد یعنی بدون Null ها .

 Set rst = db.OpenRecordset("SELECT DISTINCT [State/Province] " & _

 " FROM Customers WHERE [State/Province] IS NOT NULL", _

 dbOpenDynaset)

در کد زیر لوپی زده شده در رکوردست ( مجموعه داده )

 Do While Not rst.EOF

در اینجا بعلت جلوگیری از خطا (  بعلت اینکه تعداد داده های فیلد از سایز یا اندازه ۲۰ [تعداد ردیف ها ] بیشتر است یا ممکن است کمتر باشد )  از یک شرط استفاده شده.

 If lngCounter > lngArraySize Then

 'this would cause a problem

 Stop

 End If

در اینجا و با توجه به لوپ آرایه با داده های فیلد پر می شوند.

 strState(lngCounter) = rst![State/Province]

یک شمارشگر قرار داده تا در شرط بالا یعنی if بکار برده شود.... از DOEVENTS می توانید در اول کدها استفاده کنید تا اگر کدها را اشتباه نوشتید ( مثلا لوپ درجا بزند و پایانی نداشته باشد ) سیستم هنگ نکند

 lngCounter = lngCounter + 1

این خط ( MoveNext ) برای انتقال به رکورد بعد ( ردیف ) در رکوردست لازم است وگرنه همان داده اولین ردیف را پر می کند.

 rst.MoveNext

 Loop

در کد زیر لوپی میزند در آرایه strState و مقادیر را در صفحه immediate window نمایش میدهد ( Debug.Print ) که می توانید در صفحه ویژوال آنرا مشاهده کنید.

 For Each varAState In strState

 If varAState <> "" Then

چاپ در Debug که با Ctrl+G می توانید به صفحه مورد نظر ببرید.

 Debug.Print varAState

 End If

 Next

 Debug.Print "Lower bound : " & LBound(strState)

 Debug.Print "Upper Bound : " & UBound(strState)

حتما بعد از استفاده رکوردست را باید ببندید تا در حافظه جایی که اشغال کرده را آزاد کند.

 rst.Close

 Set rst = Nothing

 db.Close

 Set db = Nothing

End Sub



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

Dim Arr(2) As Variant

Arr(0)="A"

Arr(1)="123"

Arr(2)="01/08/1999"

?Arr(1)

123


امکانپذیراست ، آرایه ای داشته باشیدکه بتوان انداره و تعداد ابعادش را با استفاده از عبارت Redim تغییر داد.

Dim strState() As String

 lngArraySize = 8

 ReDim strState(lngArraySize)

این آرایه ها همچنین می توانند داده های موجود را هنگام تغییر اندازه با استفاده از کلمه کلیدی Preserve حفظ کنند.



عبارت Redim Preserve یک آرایه جدید ایجاد میکند و اجزاء آرایه قدیمی داخل آرایه جدید کپی می شوند... لذا فقط بعد یا اندازه تغییر کرده و منجر به از دست رفتن داده ها نخواهد شد .


For lcount = 0 To 5000000
        ReDim Preserve myText(lcount)
        myText(lcount) = lcount
    Next lcount


البته اگردر لوپ بجای lcount همان عدد 5 میلیون استفاده شود سرعتش بیشتر از زمانیست که از خود متغیر lcount استفاده کردیم.


در وهله اول به متغیر آرایه ای strState یک بعد میدهیم فرضا ۵۰ 

Do While Not rst.EOF

 strState(lngCounter) = rst![State/Province]

 lngCounter = lngCounter + 1

 rst.MoveNext

 Loop
















 

















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












Erase در آرایه



تنظیم  هر عنصربه صفر یا به "" منظور ( طول رشته به صفر ) یا آزاد کردن فضای اشغال شده  )



Dim DynamicArray() As Integer ' Dynamic array.


Erase DynamicArray ' Free memory used by array.