نمونه های کاربردی و آموزشی VBA

[amirzazadeh]

جمع صفحه در گزارش
دوستان سلام
نمونه حاضر در پاسخ به سئوال چند تن از كاربران آماده شده با اين توضيح كه دو تا تكست باكس unbound يكي در page Header با نام nagl و ديگري در Page Footer با نام page total ، اولي براي نشان دادن نقل از صفحه قبل و دومي براي جمع صفحه در نظر گرفته شده.
كدهاي به كار رفته :

Option Compare Database

Option Explicit

Dim curtotal As Currency

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

If PrintCount = 1 Then curtotal = curtotal + Me.mablagdarkhasti

End Sub



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

Me.pagetotal = curtotal

End Sub



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

Me.nagl = curtotal

curtotal = 0

End Sub

..........................
موفق باشيد

[alirezabahrami]

براي بدست آوردن مختصات موس (مختصات x و y ) از نمونه كاربردي ضميمه استفاده كنيد!
موفق باشيد

[alirezabahrami]

وقتي مي خوام از Common Dialog تو فرم خودم استفاده كنم يه Error عجيب غريب مي گيرم.

تصوير زير رو ببينين :



دوستان گلم، كمك لطفاً ........

سلام
بخش ماژول را باز كن و از قسمت References گزينه Microsoft Scripting Runtime را انتخاب ،سپس برنامه را ببند و مجدداً اجرا كن!
موفق باشيد

[abas588]

نوشته شده توسط سعید رضایی

[vbnasim]

نوشته شده توسط سعید رضایی

ضمن تشكر از شما
مي خواستم بدانم چگونه مي توانم به سورس برنامه شما دسترسي داشته باشم

[amirzazadeh]

ضمن تشكر از شما
مي خواستم بدانم چگونه مي توانم به سورس برنامه شما دسترسي داشته باشم

سلام
كافيه در هنگام باز كردن برنامه از كليد شيفت استفاده كنيد.
.........................
موفق باشيد

[linktaz]

انتخاب چند گزینه بطور همزمان از لیست باکس و نمایش اطلاعات مربوط به هر کدام.

[kamkam1]

یک دیالوگ برای Sort گزارش

با این دیالوگ در گزارش هم حالت Ascending و هم حالت Descending را جهت Sort می توان استفاد کرد .

[dadsara]

سلام
با استفاده از این کد می تونید جدول خود را حذف کنید
اگر جای AcTable از Acform یا Acquery یا . . . استفاده کنید این دستور کاربرد دارد

DoCmd.DeleteObject acTable, "table1"

[linktaz]

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

[mahdif123]

با سلام

دستور SELECT ... INTO جهت ایجاد جدول جدید شامل رکوردهای نتیجه پرس و جو

با استفاده از این دستور SQL در Query در داخل پایگاه داده می توانید جدول بک‌آپ بسازید :

 SELECT * INTO table1backup

FROM Table1; 

[smderfan]

سلام
عيد سعيد فطر مبارك.

[linktaz]

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

[جعفر88]

سلام چطوری میشه پیغامهایی که اکسس بصورت انگلیسی میده با پیامهای فارسی عوض کرد کد خطاها را هم بگین که خیلی ممنون میشم؟

براي خطا حين اجرا كد ها به نظرم از ابزارهايي نظير سري دستورهاي ...on error goto و شيء Err استفاده كنين ميشه تا حدود زيادي خطاهاي حين اجراي(run-time error) كد رو اداره كرد و پيام خاص خود را به كاربر اعلام نمود . براي خطاهاي فرم نيز از رويداد on error اون استفاده كنين تو روال اين رويداد متغيري به نام Response هست كه اگه مقدار اونو به ثابت acDataErrContinue تغيير بدين پيام خطاهاي داخلي اكسس نمايش داده نميشه و درعوض ميتونين پيامهاي فارسي رو نمايش بدين . براي كد خطاها هم راهنماي اكسس و سايت ميكروسافت منابع خوبي اند . در ضمن اگه سوالات خاص خود رو در بخش عمومي تالار مطرح كنين دوستان بهتر ميتونن پاسخ بدن ، تو اين موضوع فقط سعي كنين نمونه برنامه ارائه كنين .

[zzzzzza]

باز شدن فرم از زواياي مختلف با سرعت هاي مختلف

[zzzzzza]

بازي در اكسس

[zzzzzza]

بازي در اكسس (سئوال و جواب كابردي در اكسس)

از دست ندهيد*******

[zzzzzza]

ديگر از جان اكسس چه ميخواهيد؟

نشان دنده مشخصات هر نوع فايل توسط اكسس
FilePropertyViewer

[stabesh]

اين براي كيبورد :
https://barnamenevis.org/showthread.p...76#post1167276

[amirzazadeh]

ثبت اطلاعات از فرم و ساب فرم به صورت unbound
نمونه حاضر با استفاده از كد زير آماده شده :

Public Sub CopySelected(ByRef frm As Form)



 Dim rs, rs1 As Recordset

 

 Set rs = CurrentDb.OpenRecordset("form", dbOpenDynaset)

 rs.AddNew

 rs!ncode = Me!ncode

 rs!name_family = Me!name_family

 rs.Update

   Set rs1 = CurrentDb.OpenRecordset("child", dbOpenDynaset)

    Dim ctlSource As Control

      Dim strItems, stritems2 As String

    Dim intCurrentRow As Integer

    

    Set ctlSource = frm!List6



    For intCurrentRow = 0 To ctlSource.ListCount - 1

    ctlSource.Selected(intCurrentRow) = True

        If ctlSource.Selected(intCurrentRow) Then

 rs1.AddNew

 rs1!ncode = ctlSource.Column(0, intCurrentRow)

 rs1!farzand = ctlSource.Column(1, intCurrentRow)

 rs1!pncode = Me!ncode

 rs1.Update



        End If

        ctlSource.Selected(intCurrentRow) = False

    Next intCurrentRow

  rs.Close

  rs1.Close

  MsgBox "data successfully saved"

End Sub

[royasaz_bam]

ممنون و لطف کردین ولی نمونه را نتوانستم پیدا کنم اگر مجددا توضیح بدید (نحوه بکارگیری تابع تبدیل عدد به حروف ) بسیار ممنون میشم

[bemilove]

دوستان برای شکیلتر شدن برنامه شکل کروسر موس رو به این صورت تغییربدین:
ابتدا این ماجول را کپی کنید:

 

Option Compare Database

'***********************    Code Starts Here   **********************************

Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'=================================================  ====================

' Globals for cursor handling

    Global Const GCL_HCURSOR = (-12)

    Global hSwapCursor As Long

    Global hAniCursor As Long

'=================================================  ====================

Public Const IDC_ARROW = 32512&

Public Const IDC_IBEAM = 32513&

Public Const IDC_WAIT = 32514&

Public Const IDC_CROSS = 32515&

Public Const IDC_UPARROW = 32516&

Public Const IDC_ICON = 32641&

Public Const IDC_SIZENWSE = 32642&

Public Const IDC_SIZENESW = 32643&

Public Const IDC_SIZEWE = 32644&

Public Const IDC_SIZENS = 32645&

Public Const IDC_SIZEALL = 32646&

Public Const IDC_NO = 32648&

Public Const IDC_HAND = 32649&

Public Const IDC_APPSTARTING = 32650&

Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" _

  (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long

Declare Function LoadCursorFromFile Lib "user32" Alias _

  "LoadCursorFromFileA" (ByVal lpFileName As String) As Long

Declare Function SetCursor Lib "user32" _

  (ByVal hCursor As Long) As Long

  '

Public Function Arrow_Pointer()

    Screen.MousePointer = 1

End Function

Function ChangeCursor(strPathToCursor As String)

    On Error GoTo Error_On_ChangeCursor

  If Dir(strPathToCursor) <> "" Then

      Dim lngRet As Long

      lngRet = LoadCursorFromFile(strPathToCursor)

      lngRet = SetCursor(lngRet)

  End If

Exit_ChangeCursor:

    Exit Function

 

Error_On_ChangeCursor:

 

    Resume Exit_ChangeCursor

 

End Function

Public Function Default_Pointer()

    Screen.MousePointer = 0

End Function

Public Function IBeam_Pointer()

    Screen.MousePointer = 3

End Function

Function MouseCursor(CursorType As Long)

  Dim lngRet As Long

  lngRet = LoadCursorBynum(0&, CursorType)

  lngRet = SetCursor(lngRet)

End Function

Public Function Replace_Cursor(PathToFile As String)

    hAniCursor = LoadCursorFromFile(PathToFile)

    hSwapCursor = SetClassLong(Screen.ActiveForm.hWnd, GCL_HCURSOR, hAniCursor)

End Function

Public Function Restore_Cursor()

    hSwapCursor = SetClassLong(Screen.ActiveForm.hWnd, GCL_HCURSOR, hSwapCursor)

End Function

بعد روی رویداد MouseMove مورد نظرتان هر کدام از کدهایی که میخواید صدا بزنید مثلا برای تغییر شکل بصورت دست این کد را بزنید:

 

Call MouseCursor(32649)

 

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

[me.alizadeh]

با سلام خدمت استاد محترم
من این کار را انجام دادم در رویداد key down خطا داد
اگر امکانش هست لطف کنید یک فایک پیوست کنید .
با تشکر

با تکه کد زیر استفاده از کلیدهای - و + برای کاهش یا افزایش تاریخ در یک فیلد Date/Time امکانپذیر میشه البته لازم به ذکره که کد فعلی قابلیت کاهش یا افزایش تاریخ رو بصورت روزانه داره که اگر لازم باشه تغییر پارامتر "d" به سایر پارامترها مثل y , m , w برای کاهش یا افزایش ماه سال و هفته امکانپذیره .

کدهای زیر رو در یک Module جدید کپی کنید :

Public Function PDate(PObj As Object, KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyAdd Then

    If Shift = 2 Then

        PObj = DateAdd("m", 1, PObj)

        KeyCode = 0

    Else

        PObj = DateAdd("d", 1, PObj)

        KeyCode = 0

    End If

End If



If KeyCode = vbKeySubtract Then

    If Shift = 2 Then

        PObj = DateAdd("m", -1, PObj)

        KeyCode = 0

    Else

        PObj = DateAdd("d", -1, PObj)

        KeyCode = 0

    End If

End If

End Function

کد زیر رو هم در رویداد Key Down فیلد مورد نظر که جنسش Date/Time هست کپی کنید :
بجای FieldName نام فیلد مورد نظر رو قرار بدین

PDate Me.FieldName, KeyCode, Shift

[mojahed.morteza]

كار نميكنه اين لينك

[مهدی د]

ضمن تشکر ولی وقتی با فشردن دکمه + به آخرین روز ماه برسیم چنانچه مجددا دکمه + را فشار دهیم تاریخ به اولین روز ماه بعد منتقل نمی شود بلکه ادامه پیدا می کند و تعداد روزها بیشتر از تعداد روزهای ماه می شود.

[meli66]

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

[sajjad_kochekian]

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

Public Function number3digit(num As Currency, state As Integer) As String

Dim ln As Integer

If state = 1 Then number3digit = Right(num, 3)



If state = 2 And Len(Trim(num)) > 3 Then

    ln = Len(Right(num, 6)) - 3

    

    number3digit = Left(Right(num, 6), ln)



End If

If state = 3 And Len(Trim(num)) > 6 Then

    ln = Len(Right(num, 9)) - 6

    number3digit = Left(Right(num, 9), ln)

End If



End Function

[pmoshir]

لطفا ادامه اين فانكشن كه چطور در فرم استفاده بشه رو بزاريد.با تشكر

[sajjad_kochekian]

msgbox number3digit( 123456789,2)

[askar333]

با سلام
مطلب خوبی است برای من که مبتدی هستم بیشتر توضیح دهید
با تشکر..

[abas1388]

جناب biotechsoft سلام ،
با تشکر از جنابعالی ، فایل فوق از سایت 4Shared قابل دانلود نیست . لطفاکنترل فرمائید . در صورت امکان در خود سایت آن را ضمیمه نمائید تا همه بتوانند از این مجموعه استفاده نمایند .
با تشکر

با سلام
بنده هم امتحان كردم متأسفانه نمونه ها قابل دانلود نيستند

[ic3300]

برنامه ای که دوست عزیزمون برای صندوق قرض الحسنه فامیلی(به قول خودشون رایگان) نوشتن بعد از مدتی کار کردن کد فعالسازی می خواد که باید برای اون 95000توامن ناقابل بپردازین
در غیر این صورت تمام اطلاعاتتون رو هواست..من قبلا از این نرم افزار استفاده کردم چوبشو خورم
Biotechsoft عزیز این کاراتو نکن تو این سایت یک عده بی ریا به هم کمک میکنن از برنامه های کاربردی که برای دانلود گذاشتی فهمیدم خودت هم همه چیز رو از این سایت باحال یاد گرفتی
در ضمن عیدت مبارک

[ic3300]

با سلام
برنامه شما در بحث گزارشهای صندوق تراکنشهای وام (دریافت و پرداخت وام) رو در موجودی صندوق لحاظ نمیکنه
مثلا اگه به کسی وام دادیم یا قسط گرفتیم از موجودی کل صندوق کم و زیاد نمیشه
در ضمن پست سورس باز برنامه تو ن رو حذف کردم

[mhamedm2008]

به نظر من اکسس فوق العادست.
من نه ماهه دارم برنامه ایی با اکسس می نویسم.حدود 130 فورم و 32 تا تیبل و کلی ریپورت و کوئری داره.اصلا هم کسی که باهاش کار می کنه نمی تونه تشخصی بده این اکسس هست یا یه نرم افزار دیگه.حتی منوی تنظیمات داره که میشه خیلی از قسمت های برنامه رو تنظیم کرد و در صورت نیاز تغیرر داد و یا 500 عمل آخری که توی برنامه کاربر انجام میده رو توی لوگ خودش ذخیره می کنه. تا الان هم سر جمع توی کل تیبل هاش حدود 7500 تا تا الان رکورد ذخیره شده.همه تکس هابکس ها و فرم ها هم به صورت unbound هستن
واقعا اکسس حرف نداره

[mma_ok]

جناب Profesorjd عزیز
خیلی از این حرکت دوستمون ناراحت شدید . البته مشخصه که هدف ایشون تیلبغات و فروش برنامه حسابداری خودشونه البته اگر درست کار کنه
مطمئنا همون طور که شما هم فرمودید برنامه های خیلی بهتر و کاربردی تر و رایگان نیز در دسترس میباشد که هر کس مایل است از اونها استفاده کنه
من یک نمونه را در این قسمت قرار میدم که البته کار من نیست و من یک تغییرات جزئی توش دادم
ضمنا کاملا باز هستش و صاحبش هم اجازه انجام تغییرات رو داده رمز برنامه هم 123 است
http://www.up.98ia.com/images/m51i7m4fxlut88ybimxh.rar

یا از اینجا
http://uploadkon.ir/uploads/bfeec15f...4dd0a8e0ec.rar

[1362mn1362]

با سلام
آقای قربانی این غیر فعال و فعال کردن کلید شیفت رو من اصلا نفهمیدم . شما می تونید توی این زمینه قدم به قدم من راهنمایی بکنید؟
با تشکر

[u.2u.4u]

سلام دوستان.
در اینجا:
https://barnamenevis.org/showthread.p...86#post1509986
یه سوالی راجع به همین موضوع دارم لطفا جواب بدید. خسته شدم

[u.2u.4u]

در این فایل عملیات مختلف و جالبی مربوط به صادر و وارد کردن فایل اکسس را گنجاندم.
منبع کدها از سایت های مختلف داخلی و خارجی هست. برای یک پروژه نیاز داشتم و پس از جستجوی فراوان هر کدوم از اونها را پیدا کرده و اصلاح کردم. امیدوارم برای دوستان عزیز مفید باشد.
از اساتید محترم هم خواهشمندم به کاملتر شدن اون کمک کنند.
1- صادر کردن جداول با فرمت های متن و Html و اکسل
2- خواندن گزارش ها فرم ها و ... از فایل دیگر
3- وارد کردن گزارش ها، فرم ها و ... از فایل دیگر
4- بازیابی جداول از طریق فایل اکسلی که در مورد 1 صادر شده است.

[RESMAILY]

به نام خدا
با سلام و تشكر ازفايل تان. در ضمن يك جوابكي هم به آن مطلب تان داده ام. نگاهي بفرماييد.

[underworld]

سلام بر مهندسین عزیز

من Vba اکسس رو تقریبا میدونم چیه ولی اخیرا سر یک موضوع کوچیک گیر کردم و اوون اینه که در دیتا بیس اکسس فیلد از نوع attachment دارم که عکس آپلود کردم ولی با vba نمیتونم مقادیر رکوردهارو در image control نشون بدم.
کسی میدونه راه کارش چی هست؟