صفحه 3 از 5 اولاول 12345 آخرآخر
نمایش نتایج 81 تا 120 از 180

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

  1. #81
    کاربر دائمی آواتار Ali_Fallah
    تاریخ عضویت
    مهر 1384
    محل زندگی
    همین نزدیکی ها
    پست
    791

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

    نقل قول نوشته شده توسط Ali_Fallah مشاهده تاپیک
    اگر می خواهید برای همیشه خیالتان از بابت استفاده از تاریخ در اکسس راحت باشد از فایل dll زیر استفاده کنید
    -------------------------------------------------------------------------------------
    هر کاربر محترمی که از این فایل استفاده کرد حتماً در اینجا گزارش کند...
    با تشکر
    کسی استفاده نکرد ؟

  2. #82

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

    نقل قول نوشته شده توسط Ali_Fallah مشاهده تاپیک
    کسی استفاده نکرد ؟
    -------------------------
    با سلام
    جناب فلاح بنده استفاده كردم و جواب داد و بسيار مفيد بود از مطالب مفيد شما بسيار ممنونم .

  3. #83

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

    بازکردن و وارد کردن فایلها در اکسس
    فایل های ضمیمه فایل های ضمیمه

  4. #84
    کاربر جدید
    تاریخ عضویت
    تیر 1387
    محل زندگی
    تهران
    پست
    26

    نقل قول: محدود کردن محاسبه مجموع زمان در یک بازه زمانی خاص

    در خصوص تاپیک 62 و جناب دلشکسته:
    چطور میتوان مجموع زمان را برای بازه ای از زمان در داخل یک تیبل انجام داد.فرضا ما یک فیلد تاریخ در تیبل داریم و می خواهیم جمع ساعات کاری برای یک دوره یک ماهه شخصی را بررسی کنیم به طوری که تاریخ را از داخل یک فرم از ما بخواهد.
    ممنونم.

  5. #85

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

    دوستان برای شکیلتر شدن برنامه شکل کروسر موس رو به این صورت تغییربدین:
    ابتدا این ماجول را کپی کنید:
     
    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)


  6. #86
    مدیر بخش آواتار amirzazadeh
    تاریخ عضویت
    مهر 1386
    محل زندگی
    تبريز
    پست
    1,947

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

    با سلام خدمت دوستان
    نمونه حاضر براي جلوگيري از ورود مقادير تكراي در سابفرم آماده شده درصورت ورود داده تكراري پيامي صادر و داده حذف ميگردد.براي اين منظور از تابع DCOUNT بهره گيري شده است .اميدوارم قابل استفاده باشه.

    Private Sub girande_BeforeUpdate(Cancel As Integer)

    Dim SID As String
    Dim stLinkCriteria As String
    Dim rsc As DAO.Recordset

    Set rsc = Me.RecordsetClone

    SID = Me.girande.Value
    stLinkCriteria = "[girande]=" & "'" & SID & "'"

    If DCount("girande", "query3", _
    stLinkCriteria) > 0 Then
    'Undo duplicate entry
    Me.Undo
    'Message box warning of duplication
    MsgBox "Warning data " _
    & SID & " has already been entered." _
    & vbCr & vbCr, vbInformation, "Duplicate Information"

    End If

    Set rsc = Nothing

    End Sub

    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله amirzazadeh : سه شنبه 30 مهر 1387 در 11:47 صبح

    DON'T START;OTHERWISE DON'T STOP
    .................................................
    قوانين سايت

  7. #87
    کاربر تازه وارد آواتار saeedyaz
    تاریخ عضویت
    مهر 1387
    محل زندگی
    تهران
    سن
    47
    پست
    78

    نقل قول: Allow Bypass Key

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

    Public Function SetAllowBypassKeyFalse()

    '----- کنترل خطا
    On Error GoTo Err_SetAllowBypassKeyFalse


    Dim db As DAO.Database, prp As DAO.Property

    '----- در صورت موجود بودن Property ست کردن
    Set db = CurrentDb

    db.Properties("AllowBypassKey") = False

    Set db = Nothing


    Exit_SetAllowBypassKeyFalse:

    Exit Function

    '----- کنترل خطا
    Err_SetAllowBypassKeyFalse:

    '----- خطا در صورت موجود نبودن Property
    '----- اگر قبلاً ساخته نشده Property ساخت
    If Err = 3270 Then

    Set prp = db.CreateProperty("AllowBypassKey", dbBoolean, False)
    db.Properties.Append prp

    Resume Next

    Else

    '----- در صورت بروز خطاهای غیر منتظره
    MsgBox "SetAllowBypassKeyFalse", Err.Number, Err.Description

    Resume Exit_SetAllowBypassKeyFalse

    End If

    End Function

    مهندس این کد رو چه جوری اجرایی کنم تو on loud یا جای دیگه....

  8. #88
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

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

    سلام
    اين كد رو اول توي يك ماجول كپي و ذخيره كنيد ، بعد مثلاً در لود فرم اصلي برنامه يا يك كامند باتون اين عبارت رو بنويسيد : SetAllowBypassKeyFalse
    البته اگر يك بار اين ماجول اجرا بشه ديگه براي هميشه شيفت بسته ميشه و احتياجي نيست كه هر بار برنامه لود ميشه اين عمل تكرار بشه بنابر اين مي تونيد يك فرم در فايل بذاريد به همراه كامند باتون كه فقط در صورت نياز بهش رجوع كنيد . ويك نكته مهم اينكه حتماً قبل از بستن شيفت يك كپي لز فايل رو در جايي ذخيره كنيد .

  9. #89
    مدیر بخش آواتار amirzazadeh
    تاریخ عضویت
    مهر 1386
    محل زندگی
    تبريز
    پست
    1,947

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

    نمونه آموزشي براي مديريت فيلدهاي الزامي با پيام هاي فارسي
    لطفا فايل ضميمه رو ببينيد:
    درصورت عدم ورود فيلدهاي الزامي پيام خطا صادر ميگردد
    Option Compare Database

    Private Sub Form_Error(DataErr As Integer, Response As Integer)

    'If an error occurs because of missing data in a required field
    'display our own custom error message

    Const conErrRequiredData = 3314
    Const conErrNotSavedData = 2169

    If DataErr = conErrRequiredData Then
    MsgBox ("درج اطلاعات در اين فيلد الزامي است")

    If IsNull(Me.NationalId) Then
    Me.NationalId.SetFocus
    Me.NationalId.BackColor = vbYellow

    ElseIf IsNull(Me.tel) Then
    Me.tel.SetFocus
    Me.tel.BackColor = vbYellow
    End If
    Response = acDataErrContinue
    ElseIf DataErr = conErrNotSavedData Then
    MsgBox ("داده ذخيره نشد")
    Response = acDataErrContinue
    Else
    'Display a standard error message
    Response = acDataErrDisplay
    End If
    End Sub

    Private Sub NationalId_AfterUpdate()
    Me.NationalId.BackColor = vbWhite
    End Sub

    Private Sub tel_AfterUpdate()
    Me.tel.BackColor = vbWhite
    End Sub
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله amirzazadeh : سه شنبه 14 آبان 1387 در 11:48 صبح

    DON'T START;OTHERWISE DON'T STOP
    .................................................
    قوانين سايت

  10. #90
    کاربر دائمی آواتار Ali_Fallah
    تاریخ عضویت
    مهر 1384
    محل زندگی
    همین نزدیکی ها
    پست
    791

    جلوگیری از حذف جداول

    در مرحله اول کدهای زیر را در یک ماژول کیی کنید

    Option Compare Database

    Public Function StopManualTableDelete(YesOrNo As String)

    Dim fld As DAO.Field
    Dim db As DAO.Database
    Dim tbl As DAO.TableDef
    Dim SQL_CreateConstraint As String, SQL_DropConstraint As String
    Dim strConstraint As String ' this variable holds the name of the constraint
    Dim i As Integer
    Dim tblNames As String, DeleteInfo As String

    Set db = CurrentDb()

    i = 0
    For Each tbl In db.TableDefs
    ' Bypass system tables with autonumbers
    ' Also any hidden table that starts with "~"
    If Mid(tbl.Name, 1, 4) <> "MSys" Then
    If Left(tbl.Name, 1) <> "~" Then
    For Each fld In db.TableDefs(tbl.Name).Fields
    If dbAutoIncrField = (fld.Attributes And dbAutoIncrField) Then 'Find autonumber

    DoCmd.Hourglass True
    strConstraint = "con_" & fld.Name & "_" & tbl.Name 'Build constraint name

    If YesOrNo = "YES" Then
    i = i + 1
    'Drop any existing autonumber field constraints if there is one.
    If FindCheckConstraint(strConstraint) = True Then
    SQL_DropConstraint = "ALTER TABLE " & tbl.Name & _
    " DROP CONSTRAINT " & strConstraint

    CurrentProject.Connection.Execute SQL_DropConstraint
    End If
    DoEvents ' await a while just in case

    'create the new constraint to disallow the table from being deleted.
    SQL_CreateConstraint = " ALTER TABLE " & tbl.Name & " ADD " & _
    " CONSTRAINT " & strConstraint & _
    " CHECK (" & fld.Name & " IS NOT NULL))"
    'Debug.Print SQL_CreateConstraint
    CurrentProject.Connection.Execute SQL_CreateConstraint

    DeleteInfo = "äãí ÊæÇäíÏ"
    End If

    If YesOrNo = "NO" Then
    'Drop any existing autonumber field constraints.
    If FindCheckConstraint(strConstraint) = True Then
    i = i + 1
    SQL_DropConstraint = "ALTER TABLE " & tbl.Name & _
    " DROP CONSTRAINT " & strConstraint

    CurrentProject.Connection.Execute SQL_DropConstraint

    DeleteInfo = "ãí ÊæÇäíÏ"
    End If
    End If

    tblNames = tblNames & tbl.Name & vbNewLine

    Exit For
    End If
    Next fld
    End If
    End If
    Next tbl

    db.Close
    Set db = Nothing
    DoCmd.Hourglass False

    If i > 0 Then
    MsgBox i & " ÊäÙíãÇÊ ÑÇ ÈÕæÑÊí ÇäÌÇã ÏÇÏå ÇíÏ ˜å " & DeleteInfo & " ÌÏÇæá ÑÇÈÕæÑÊ ÏÓÊí ÍÐÝ ˜äíÏ æ ÊÚÏÇÏÔÇä" _
    & vbNewLine & ": ãæÑÏãí ÈÇÔÏ. Çíä ÌÏÇæá ÔÇãá" & vbNewLine & vbNewLine & tblNames
    Else
    MsgBox "There are no tables with Autonumber fields present in this database." _
    & vbNewLine & "Therefore this code did not have any effect on this database."
    End If

    End Function
    ''''''''''''''''''''''''''''''
    Public Function FindCheckConstraint(MyConstraint As String) As Boolean
    'this function checks to see if a check constraint already exist on the autonumber field.

    Dim fld As ADODB.Field
    Dim rst As ADODB.Recordset
    Set rst = CurrentProject.Connection.OpenSchema(adSchemaCheck Constraints)

    Do Until rst.EOF
    For Each fld In rst.Fields
    If fld.Name = "CONSTRAINT_NAME" Then
    If fld.Value = MyConstraint Then
    'Debug.Print fld.Value
    FindCheckConstraint = True
    Exit For
    End If
    End If
    Next fld
    rst.MoveNext
    Loop

    End Function

    'StopManualTableDelete("Yes") ÈÇ ÇäÊÎÇÈ Çíä Òíäå Úãá ÍÐÝ ÇäÌÇã äãíÔæÏ
    'StopManualTableDelete("NO") ÈÇ ÇäÊÎÇÈ Çíä Òíäå Úãá ÍÐÝ ÇäÌÇã ãíÔæÏ



    در مرحله دوم در نمای ماژول کلید Ctl+G را همزمان فشرده تا قسمت Immediate نمایش داده شود سپس کد زیر را در آنجا کپی کرده و دکمه Enter برنید

    StopManualTableDelete("Yes") 


    حالت yes باعث عدم حذف جداول و حالت No باعث حذف جداول میشود.
    میتوانید فقط بجای Yes _ کلمه No بنویسید
    هربار که جدول جدید ایجاد می کنید برای عدم حذف میبایست مرحله دوم را مجدداً تکرار کنید
    موفق باشید
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله Ali_Fallah : پنج شنبه 16 آبان 1387 در 20:16 عصر دلیل: اضافه نمودن نمونه برنامه

  11. #91
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

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

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

  12. #92

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

    مقايسه اي بين SQLserver 2000 و MSAccess 2000

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

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

    http://www.macromediax.com/Learn/archive.asp?id=92

  13. #93

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

    امنيت در اكسس

    فايلهاي Access در حالت عادي از امنيت خوبي برخوردار نيستند . نرم افزار MDB Secure 2008 نام برنامه اي است كه اين كار را براي شما انجام مي دهد . اين برنامه تعدادي از قابليتهاي بانك اكسس را فعال مي كند كه باعث بالا بردن امنيت نهايي فايل MDB مي شود . اين كارها در اين برنامه با چند كليك ، راحت انجام مي شود در حاليكه براي فعال كردن آنها به صورت دستي در اكسس حدود 30 دقيقه براي هر ديتا بيس طول مي كشد .
    نسخه اصلي اين برنامه رايگان نمي باشد و شما مي توانيد نسخه Trial آن را دانلود كنيد .

    ---------------------------------------
    http://www.mindwarp-consultancy-soft...-download.html

  14. #94
    مدیر بخش آواتار amirzazadeh
    تاریخ عضویت
    مهر 1386
    محل زندگی
    تبريز
    پست
    1,947

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

    ايجاد پشتيبان در مسير دلخواه با درج تاريخ شمسي در انتهاي نام فايل بدون overwrite روي پشتيبان هاي قبلي
    لطفا نمونه را ببينيد:(با ذكر اين نكته كه براي توليد نام پشتيبان از توابع دستكاري شده جناب آزادي بهره گرفته شده است)
    قبل از اجرا فايل comdlg32.ocx را در داخل پوشه سيستم 32 كپي و رجسيتر نماييد.
    Option Compare Database
    Dim CommondialogControl2 As Control
    Dim backfile As New FileSystemObject
    Dim source As String, desti As String
    Dim x, y, z As Integer

    Private Sub Command0_Click()
    On Error GoTo err
    source = Application.CurrentProject.FullName

    x = Len(Application.CurrentProject.Name)
    desti = Mid(Application.CurrentProject.Name, 1, x - 4) & Make_Date(Shamsi(Date)) & ".mdb"
    With CommonDialog2
    .DialogTitle = "Backup"
    .Filter = "mdbfles (*.mdb)|*.mdb"
    .FileName = desti
    FileName = .FileName
    check2:
    If Dir(FileName) = "" Then
    .FileName = FileName
    .ShowSave
    FileName = .FileName
    backfile.CopyFile source, FileName, False
    Else
    GoTo check

    check:
    FileName = .FileName
    y = Len(FileName)
    z = z + 1
    FileName = Mid(FileName, 1, y - 4) & "(" & z & ")" & ".mdb"
    GoTo check2

    End If

    MsgBox "Databas has been backedup in" & " " & FileName, vbInformation
    End With
    Exit Sub
    err:
    Beep
    End Sub

    Private Sub Command1_Click()
    On Error GoTo err
    desti = Application.CurrentProject.FullName
    If MsgBox("are you sure", vbOKCancel, "restore") = vbOK Then
    With CommonDialog2

    .DialogTitle = "Restore"
    .Filter = "Access Files(*.mdb)|*.mdb"
    .ShowOpen
    source = .FileName
    End With
    backfile.CopyFile source, desti, True
    MsgBox "Databas has been restored", vbInformation
    Else
    Cancel = True
    End If
    Exit Sub
    err:
    Beep
    End Sub
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله amirzazadeh : چهارشنبه 29 آبان 1387 در 08:26 صبح دلیل: اصلاح كد

    DON'T START;OTHERWISE DON'T STOP
    .................................................
    قوانين سايت

  15. #95
    کاربر تازه وارد
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    ايران
    پست
    38

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

    جلوگیری از حذف جداول
    با تشکر از آقای فلاح
    آیا کدی برای جلوگیری از Import/Export شدن جدواول نیز جود د ارد؟

  16. #96

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

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

  17. #97
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

    ساخت جدول با کد VBA و کلکسیون DAO

    من کد ایجاد جدول با استفاده از فرم را میخوام از دوستانی که میتوانند کمکم کنند خواهش می کنم این کد رو بفرستند.
    این کد برای ایجاد جدول در دیتابیس جاری کاربرد داره .
    دریک فرم کامند باتونی ایجاد و کدهای زیر رو در رخداد کلیک اون کپی کنید و بجای Command0 نام کامند باتون مورد نظرتون رو جایگزین کنید

    Private Sub Command0_Click()
    Dim MyDatabase As Database
    Dim NewTable As TableDef
    Dim MyArtist As DAO.Index
    Dim MyIndex2 As DAO.Index
    Dim MyIndex3 As DAO.Index

    ' open database
    Set MyDatabase = CurrentDb 'OpenDatabase(App.Path + "\mp3Base.mdb")
    'create the table
    Set NewTable = MyDatabase.CreateTableDef("mp3New")
    On Error Resume Next
    'delete the table if it already exists
    MyDatabase.TableDefs.Delete NewTable.Name

    'add the fields in the table, those used below are just an example
    With NewTable
    .Fields.Append .CreateField("Title", dbText, 30)
    .Fields.Append .CreateField("Artist", dbText, 30)
    .Fields.Append .CreateField("Album", dbText, 30)
    .Fields.Append .CreateField("Year", dbText, 4)
    .Fields.Append .CreateField("Comment", dbText, 30)
    .Fields.Append .CreateField("Genre", dbText, 1)
    .Fields.Append .CreateField("Position", dbText, 10)
    End With

    'add indexes in the table
    Set MyArtist = NewTable.CreateIndex("Artist")
    MyArtist.Fields.Append MyArtist.CreateField("Artist")
    NewTable.Indexes.Append MyArtist
    Set MyIndex2 = NewTable.CreateIndex("Title")
    MyIndex2.Fields.Append MyIndex2.CreateField("Title")
    NewTable.Indexes.Append MyIndex2
    Set MyIndex3 = NewTable.CreateIndex("Position")
    MyIndex3.Fields.Append MyIndex3.CreateField("Position")
    NewTable.Indexes.Append MyIndex3

    NewTable.Indexes.Refresh
    MyDatabase.TableDefs.Append NewTable
    MsgBox "جدول با موفقیت ایجاد شد"

    'close database
    MyDatabase.Close
    End Sub
    نمونه مرتبط :
    فایل های ضمیمه فایل های ضمیمه

  18. #98
    کاربر دائمی
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    هرجا که چیزی برای یادگرفتن باشد
    پست
    1,260

    نقل قول: ساخت جدول با کد VBA و کلکسیون DAO

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

    Private Sub Command0_Click()
    Dim MyDatabase As Database
    Dim NewTable As TableDef
    Dim MyArtist As DAO.Index
    Dim MyIndex2 As DAO.Index
    Dim MyIndex3 As DAO.Index

    ' open database
    Set MyDatabase = CurrentDb 'OpenDatabase(App.Path + "\mp3Base.mdb")
    'create the table
    Set NewTable = MyDatabase.CreateTableDef("mp3New")
    On Error Resume Next
    'delete the table if it already exists
    MyDatabase.TableDefs.Delete NewTable.Name

    'add the fields in the table, those used below are just an example
    With NewTable
    .Fields.Append .CreateField("Title", dbText, 30)
    .Fields.Append .CreateField("Artist", dbText, 30)
    .Fields.Append .CreateField("Album", dbText, 30)
    .Fields.Append .CreateField("Year", dbText, 4)
    .Fields.Append .CreateField("Comment", dbText, 30)
    .Fields.Append .CreateField("Genre", dbText, 1)
    .Fields.Append .CreateField("Position", dbText, 10)
    End With

    'add indexes in the table
    Set MyArtist = NewTable.CreateIndex("Artist")
    MyArtist.Fields.Append MyArtist.CreateField("Artist")
    NewTable.Indexes.Append MyArtist
    Set MyIndex2 = NewTable.CreateIndex("Title")
    MyIndex2.Fields.Append MyIndex2.CreateField("Title")
    NewTable.Indexes.Append MyIndex2
    Set MyIndex3 = NewTable.CreateIndex("Position")
    MyIndex3.Fields.Append MyIndex3.CreateField("Position")
    NewTable.Indexes.Append MyIndex3

    NewTable.Indexes.Refresh
    MyDatabase.TableDefs.Append NewTable
    MsgBox "جدول با موفقیت ایجاد شد"

    'close database
    MyDatabase.Close
    End Sub
    نمونه مرتبط :
    سلام
    من برنامه شما را اجرا نمودم و برروی اولین خط "MyDatabase As Database" ارور می گیرد
    لطفا بفرمائید خطای کار من در کجاست

  19. #99
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

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

    سلام
    من برنامه شما را اجرا نمودم و برروی اولین خط "MyDatabase As Database" ارور می گیرد
    لطفا بفرمائید خطای کار من در کجاست
    سلام
    ببینید در قسمت References گزینه Microsoft DAO Objects Library 3.6 تیک خورده ؟

  20. #100
    کاربر دائمی
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    هرجا که چیزی برای یادگرفتن باشد
    پست
    1,260

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

    بله گزینه مورد نظر تیک خورده

  21. #101
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

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

    سلام
    این عبارت رو به این شکل تغییر بدید ببینید درست میشه :
    Dim MyDatabase As Database

    به این شکل

    Dim MyDatabase As DAO.Database

  22. #102
    کاربر دائمی
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    هرجا که چیزی برای یادگرفتن باشد
    پست
    1,260

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

    سلام
    کد موردنظر را تغییر دادم ارور پیش آمده از روی آن خط عبور کرده و حال برروی خط زیر ارور می گیرد
    کد HTML:
    .Fields.Append .CreateField("Title", dbText, 30)

  23. #103
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

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

    سلام
    عجيبه ! من كه نه در 2007 و نه در 2003 به مشكلي برنخوردم ، شما از چه ورژني استفاده مي كنيد و ضمناً اگر مقدوره رفرنسهايي كه تيك خورده رو اعلام كنيد .

  24. #104
    کاربر دائمی
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    هرجا که چیزی برای یادگرفتن باشد
    پست
    1,260

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

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

  25. #105
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

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

    سلام
    رفرنسهاتون هم کاملاً درسته حالا چرا ارور دارین الله اعلم ، این فایل رو روی یک دستگاه دیگه هم تست کنید و نتیجه رو اعلام کنید .

  26. #106
    کاربر دائمی
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    هرجا که چیزی برای یادگرفتن باشد
    پست
    1,260

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

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

  27. #107
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

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

    سلام
    احتمال میدم که Collection های موجود در VBA شما دچار اشکال شده و درست عمل نمی کنن بنابراین بهتره یکبار Office رو Uninstall و مجدداً نصب کنید .

  28. #108
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

    تغییر Caption (برچسب ) فیلدهای جدول با استفاده از کدهای VBA


  29. #109

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

    ضمن سلام به حضور dadsara

    مطمئناً مشکل در بخش References وجود داره .
    عملاً Access در صورت وجود رفرنسی که در کنار آن واژه Missing درج شده باشد , در هنگام اجرای کد با خطا مواجه میشه .
    با توجه به استفاده از DAO در داخل کدهای شما , نقیصه الزاماً با برداشتن تیک کنار Reference معیوب رفع میشه

    دلایل ایجاد این نقیصه میتونه :

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

    ضمناً توصیه میشه دوستان مقداری هم در خصوص گزینه Priority تحقیق کنن

    با تشکر از شما

  30. #110

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

    با سلام

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

    من با کد زیر اینکار رو انجام میدم
    DoCmd.Maximize
    SendKeys "{F5}"
    SendKeys "500"
    SendKeys "{Enter}"


    کد فوق باید در رویداد OnActive گزارش قرار بگیره

    روشی دیگر:
    دوستمون آقای پیروزمهر هم روش دیگه ای رو پیشنهاد کردن :
    DoCmd.Maximize
    SendKeys "{End}"

    این دستور کوتاهتر و خواناتره. البته توجه داشته باشید در صورتی که خاصیت AutoResize ریپورت No باشه به صفحه آخر نمیره

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

    موفق باشید...
    آخرین ویرایش به وسیله e601 : شنبه 26 بهمن 1387 در 21:58 عصر دلیل: تکمیل مطالب

  31. #111

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

    سلام
    من دنبال گزارش یا کدی هستم که بتونم شماره های جا افتاده در یک فیلد رو بهم نشون بده
    مثلا یه جدول دارم به نام doc و یه فیلدداره به اسم no.
    رکورد های این فیلد هم به صورت زیره:
    1,2,4,5,7,9,10
    می خوام یه گزارش بسازم که اعداد 3و6و8 که از مجموعه 1 تا 10 جا افتاده رو بهم نشون بده

  32. #112
    کاربر دائمی
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    هرجا که چیزی برای یادگرفتن باشد
    پست
    1,260

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

    سلام
    دوست عزیز قبلا یک تاپیک با موضوعی شبیه همین عنوان ایجاد شده بود و به جواب هم رسید
    درصورتیکه تاپیک خواسته جنابعالی را اجابت نمی کند نسبت به ایجاد یک تاپیک مستقل اقدام نمائید تا جواب مناسب ارائه گردد

  33. #113

    Red face نقل قول: Hide/Unhide Navigation Pane with code

    باسلام. یک کد مخفی کننده navigation pan می خوام. اگه دوستی داره، لطفا کمک کنه...
    در ضمن ایا روشی برای exe کردن فایل های اکسس وجود داره؟
    آخرین ویرایش به وسیله iman56 : سه شنبه 30 تیر 1388 در 16:15 عصر

  34. #114

    نقل قول: Hide/Unhide Navigation Pane with code

    نقل قول نوشته شده توسط iman56 مشاهده تاپیک
    باسلام. یک کد مخفی کننده navigation pan می خوام. اگه دوستی داره، لطفا کمک کنه...
    در ضمن ایا روشی برای exe کردن فایل های اکسس وجود داره؟
    داخل همین بخش جستو جو کن پیدا میکنید
    برای سؤال دوم هم تا حالا روشی برای این کار من نشنیدم و فکر نکنم وجود داشته باشه

  35. #115

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

    یک سؤال هم داشتم
    در access 2007 کدی هست که کلیدهای باز و بسته و تغییر اندازه بالای ا کسس حذف شود
    ممنون میشوم راهنمایی کنید

  36. #116
    کاربر دائمی آواتار مهدی قربانی
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    تهران
    پست
    2,435

    نقل قول: Hide/Unhide Navigation Pane with code

    نقل قول نوشته شده توسط iman56 مشاهده تاپیک
    باسلام. یک کد مخفی کننده navigation pan می خوام. اگه دوستی داره، لطفا کمک کنه...
    در ضمن ایا روشی برای exe کردن فایل های اکسس وجود داره؟
    سلام
    براي Navigation Pan به صفحات قبل اين تاپيك رجوع كنيد نمونه گذاشته شده
    در مورد سئوال دومتون هم دوست عزيز ظاهراً اصلاً جستجويي نكرديد بارها در اين مورد تاپيك ايجاد شده و موضوع مورد بحث قرار گرفته !!

  37. #117
    مدیر بخش آواتار amirzazadeh
    تاریخ عضویت
    مهر 1386
    محل زندگی
    تبريز
    پست
    1,947

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

    اخذ مشخصات سخت افزاري كامپيوتر

    نمونه ارائه شده براي به دست آوردن مشخصات سيستم كاربرد داره اميدوارم به دردتون بخوره
    براي اجراي صحيح بايد رفرنس
    Microsoft WMI Scripting v2.1 libraryتيك خورده باشه
    Public Function GetPCInfo()
    'You need to have Microsoft WMI Scripting v2.1 library Registered in your references
    DoCmd.Hourglass True

    Dim SWbemSet(Arr) As SWbemObjectSet
    Dim SWbemObj As SWbemObject
    Dim varObjectToId(Arr) As String
    Dim varSerial(Arr) As String
    Dim i, j As Integer
    Dim fld As String

    On Error Resume Next
    varObjectToId(1) = "Win32_Processor,Name"
    varObjectToId(2) = "Win32_Processor,Manufacturer"
    varObjectToId(3) = "Win32_Processor,ProcessorId"
    varObjectToId(4) = "Win32_BaseBoard,SerialNumber"
    varObjectToId(5) = "Win32_BaseBoard,manufacturer"
    varObjectToId(6) = "Win32_Baseboard,product"
    varObjectToId(7) = "Win32_BIOS,Manufacturer"
    varObjectToId(8) = "Win32_OperatingSystem,SerialNumber"
    varObjectToId(9) = "Win32_OperatingSystem,Caption"
    varObjectToId(10) = "Win32_DiskDrive,Model"
    For i = 1 To Arr
    Set SWbemSet(i) = GetObject("winmgmts:{impersonationLevel=impersonat e}").InstancesOf(Split(varObjectToId(i), ",")(0))
    varSerial(i) = ""
    For Each SWbemObj In SWbemSet(i)
    varSerial(i) = SWbemObj.Properties_(Split(varObjectToId(i), ",")(1)) 'Property value
    varSerial(i) = Trim(varSerial(i))
    If Len(varSerial(i)) < 1 Then varSerial(i) = "Unknown value"
    Next
    fld = "Txt" & i
    Forms("FrmSystemInformationReader")(fld) = varSerial(i)
    Next
    DoCmd.Hourglass False
    End Function


    .......................
    موفق باشيد
    فایل های ضمیمه فایل های ضمیمه

    DON'T START;OTHERWISE DON'T STOP
    .................................................
    قوانين سايت

  38. #118

    نقل قول: شمارشگر رکوردها Navigation Records

    سلام دوست عزیز من تازه کارم این موردی که گفتین رو نتونستم فعال کنم خطا می ده چه کنم
    ضمناً فراموش نکنید اگر در References وی بی ای ، گزینه Microsoft DAO 3.6 Object Library چک نخورده حتماً فعالش کنید .
    "Name conflicts with existing module, project, or object library"
    ممنون میشم جوابمو بدین

  39. #119
    مدیر بخش آواتار amirzazadeh
    تاریخ عضویت
    مهر 1386
    محل زندگی
    تبريز
    پست
    1,947

    نقل قول: شمارشگر رکوردها Navigation Records

    نقل قول نوشته شده توسط rezaicom مشاهده تاپیک
    سلام دوست عزیز من تازه کارم این موردی که گفتین رو نتونستم فعال کنم خطا می ده چه کنم
    ضمناً فراموش نکنید اگر در References وی بی ای ، گزینه Microsoft DAO 3.6 Object Library چک نخورده حتماً فعالش کنید .
    "Name conflicts with existing module, project, or object library"
    ممنون میشم جوابمو بدین
    دوست من شما بايد اين رفرنس رو فعال كنيد:Microsoft WMI Scripting v2.1 library
    ................................
    موفق باشيد

    DON'T START;OTHERWISE DON'T STOP
    .................................................
    قوانين سايت

  40. #120
    کاربر دائمی آواتار ryonis
    تاریخ عضویت
    شهریور 1387
    محل زندگی
    تهران - بخارست
    پست
    172

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

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

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



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

صفحه 3 از 5 اولاول 12345 آخرآخر

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •