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

جمع صفحه در گزارش
دوستان سلام
نمونه حاضر در پاسخ به سئوال چند تن از كاربران آماده شده با اين توضيح كه دو تا تكست باكس 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

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

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

نقل قول:

---

نوشته شده توسط ryonis

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

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

http://www.freeuploadimages.org/imag...gorzzli41x.jpg

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

---

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

نوشته شده توسط سعید رضایی:لبخندساده:

نقل قول:

---

نوشته شده توسط abas588

نوشته شده توسط سعید رضایی:لبخندساده:

---

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

نقل قول:

---

نوشته شده توسط vbnasim

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

---

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

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

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

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

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

DoCmd.DeleteObject acTable, "table1"

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

با سلام

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

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

 SELECT * INTO table1backup

FROM Table1; 

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

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

نقل قول:

---

نوشته شده توسط m_bargostavan_66

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

---

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

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

بازي در اكسس

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

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

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

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

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

ثبت اطلاعات از فرم و ساب فرم به صورت 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

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

نقل قول:

---

نوشته شده توسط صبا9841

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

 

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)

 

---

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

با سلام خدمت استاد محترم
من این کار را انجام دادم در رویداد 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

---

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

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

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

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

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

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

msgbox number3digit( 123456789,2)

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

نقل قول:

---

نوشته شده توسط Power_User

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

---

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

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

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

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

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

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

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

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

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

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

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

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