osama457

لم اطلع على المثال

لكني كنت جهزت هذه المشاركة وانقطع علي الاتصال

افترض انه عندك متغير عام Public في وحدة نمطية

يعني مثلا عندك في اعلى الوحدة النمطية عبارة

Global MyNumber As Long
أو
Public MyNumber As Long

وتريد ان تنشيء استعالام يستند إليه فانشئ Function جديد في وحدة نمطية وخلينا نسميه MyNumberValue ونكتبه بالشكل التالي

Function MyNumberValue() As Long
MyNumberValue = MyNumber
End Function

وهذا مثال

http://www.pcpages.com/osama457/Ex555.zip

ملاحظة

اذا فتحت لك صفحة وظهر لك العبارة

To begin your download, Click Here

اضغط عليها

Ex555.zip

DoCmd.Close acForm, "اسم_النموذج", acSaveNo
أو
DoCmd.Close acForm, "اسم_النموذج", acSaveYes
أو
DoCmd.Close acForm, "اسم_النموذج", acSavePrompt

وذلك حسب رغبتك في حفظ النموذج قبل إغلاقه

طيب

خليها في خصياص النموذج في حدث قبل التحديث

لو جربت انك تستخدم الكود في حدث قبل التحديث للحقل b

تكتب

If a>b then
msgbox "خطأ" ,,""
cancel = -1
end if

هذا ممكن . لكن فيه صعوبة حسب ما اعلم .

وانا اسال سوال دايم أحب اساله نفسي قبل ما اضيف أو اعمل شي في برنامج : هل أهمية هذا توازي الجهد اللي سأبذله للوصول إلى تحقيقه؟

عموما : عندي فكرتين مبدئيتين:

الاولى : انك تنشئ جدول جديد ، وتخليه أربع حقول :

الاسم 1 ، الرقم 1 ، الاسم 2 ، الرقم 2 .

ثم قبل ما تفتح النموذج تشغل استعلام حذف يمسح بيانات الجدول الجديد ، ثم تشغل استلعام إلحاق وتلحق سجلات جدولك الاصلي في الجدول الجديد ، بحيث تدخل نصف السجلات في الحقلين : الاسم 1 ، الرقم 1، وتدخل نصف السجلات في الحقلين : الاسم 2 ، الرقم 2 .

الفكره الثانية : انك تجعل في النموذج نموذجين فرعيين بجانب بعض ، وتنسقها بحيث ما يظهر كانها نماذج فرعية ، وتخلي كل نموذج يعرض نصف السجلات فقط ، يعني مثلا تخلي النموذج الاول يعرض الارقام الفردية , والثاني الزوجية.

هذا كود بسيط يلبي حاجتك

يحتاج تعدل فيه كلمة t1 باسم الجدول عندك

وكلمة TheId باسم حقل الترقيم التلقائي فيه

Function SpecialAutoNumber(InNumber As Long)
InNumber = InNumber - 1
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO t1 ( TheId ) SELECT " & InNumber & " AS Expr1;"
DoCmd.RunSQL "DELETE t1.*, t1.TheId FROM t1 WHERE (((t1.TheId)=" & InNumber & "));"
DoCmd.SetWarnings True
End Function

وهو عن طريق استعلام اضافه ثم استعلام حذف موجود في المثال المرفق مع كود افضل منه باستخادم DAO وهو :

Function SpecialAutoNumberByDAO(InNumber As Long)
On Error GoTo Description_Of_Err
Dim dbs As Database
Dim rst As Recordset
InNumber = InNumber - 1
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("t1", dbOpenDynaset)
With rst
    If rst.RecordCount <> 0 Then
        .FindFirst "[TheId]>" & InNumber
        If Not .NoMatch Then
            MsgBox "لم يتم تعديل الترقيم التلقائي" & vbCrLf & _
            "لوجود رقم أكبر أو مساوي للرقم المدخل", , ""
            GoTo LastFunction
        End If
    End If
    
    .AddNew
    !TheId = InNumber
    .Update
    
    .MoveFirst
    .FindFirst "[TheId]=" & InNumber
    .Delete
End With

LastFunction:
rst.Close
Set rst = Nothing
Set dbs = Nothing
Exit Function

Description_Of_Err:
If Err.Number <> 3022 Then
    MsgBox Err.Number & vbCrLf & Err.Description, , "Error"
Else
   'MsgBox Err.Number
    GoTo LastFunction
End If
End Function

from1000_22.zip

أخي الفاضل

الحل السهل بواسطة عبارة SQL بدلا من كود

افتح التقرير في عرض التصميم، واطلع على مصدر السجل في خصايص التقرير

الموضوع له أكثر من حل

فيه حل سهل ما يحتاج كود

أنك تعمل استعلام جديد ، وتعمل فيه حقل جديد يضم كل الحقول غير الفارغة وعناوينها

ثم تعمل تقرير من هذا الاستعلام

وهذا مثال فيه اكثر من طريقة

واتوقع عند الاخوان غيرها

SpecialRep44.zip

كود

Function FoundMacro(InMacroName As String) As Boolean
    Dim obj As AccessObject, dbs As Object
    Set dbs = Application.CurrentProject
    For Each obj In dbs.AllMacros
            If obj.Name = InMacroName Then
                FoundMacro = True
                Exit For
             End If
    Next obj
End Function

Sub FindRunDeleteMacro(InMacroName As String)
If FoundMacro(InMacroName) Then
    DoCmd.RunMacro InMacroName
    DoCmd.DeleteObject acMacro, InMacroName
Else
    MsgBox "لم يتم العثور على ماكرو باسم  " & InMacroName, , ""
End If
End Sub

وبرفقه ملف

FindMacro33.zip

أعتذر أخوي

السؤالين ما عندي لهن جواب

(( وان كنت جربت موضوع ماكرو autoexe وكان ماشي بدون مشاكل))

اخوي مصلح

السلام عليكم

غالي انت علينا لكن ما باليد حيلة لان سؤالك للمحترفين

لكن هل فكرت في حل مؤقت وهو البحث عن كود يتعرف على أقراص الجهاز وأسمائها ثم البحث فيها

عل عجل هذا كود يتعرف على محركات الاقرص (من التعليمات مع شوية تعديل)

Sub ShowDriveList()
    Dim fs, d, dc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dc = fs.Drives
    For Each d In dc
        s = s & d.DriveLetter & vbCrLf
    Next
    MsgBox s
End Sub

السلام عليكم

المثال هذا ممكن يفيدك

Avg33.zip

السلام عليكم :

جرب قناع إدخال (عشرة أصفار)

السلام عليكم

في راس الصفحة في التقرير في حدث عند التنسيق اكتب

If Me.Page <> 1 Then Me.PageHeaderSection.Height = 7 * 567

وهذا مثال

SecPage22.zip

السلام عليكم

نفرض ان حقل القائمة اسمه List1

التقرير اسمه rb1

حقل رقم الفاتورة في مصدر التقرير (الاستعلام ، الجدول ، عبارة SQL ) اسمه

f_Number

في حدث عند النقر المزدوج للقائمة اكتب

If IsNull(Me.List1) Then Exit Sub
DoCmd.OpenReport "rb1", acViewPreview, , "[f_number]=" & Me.List1

شاهد المثال

http://www.pcpages.com/osama457/OpenFromList.zip

اخوي فهد

السلام عليكم

طيب ...

بن محفوظ ؟

با شميل ؟

ولد صالح ؟ (زي ما عند الموريتانيين)

أحمد بن صالح بن فهد الفلاني

الأسماء المعبدة اللي فيها مسافة مثل : عبد الرحمن

الاسما المركبة : فضل ربي فضل الكريم صلاح الدين محمد علي لو كان محمد علي اسم مركب

إشكالات ما تنتهي ...

والحل في رايي : يكون الكود في نموذج الإدخال عند إدخال الاسم ثم لمدخل البيانات حرية التعديل في مثل هذه الحالات .

واحسن من كذا : ان ادخال الاسم يكون في حقول ما هو في حقل واحد

بالمناسبة عندي طريقة سويتها لحل مثل هالاشكالات ، لكن لما شفتها ها لاشكالات اللي ما تنتهي ما طورتها ،وهي تحتاج تطوير في الكود لان الكود طويل ويمكن فيه متغيرات ما لها حاجة

TaqseemMotawar11.zip

بعد اذن استاذنا محمد طاهر

هذي طريقة للتقسيم

وانا في الحقيقة ما شفت المثال اعلاه لان ما عندي برنامج رار

TaqseemName.zip

يمكن من الاسهل يكون استعلام الحاق يضيف من الجدول للجدول نفسه ، وبدل حقل الرقم يكون تعبير نستنتج منه الرقم الجديد ، وفي المعايير يحدد الرقم المطلوب نسخه

مثال

عندنا جدول اسمه Tbl1 فيه حقول

TheNumber حقل رقم مفتاح ، ما هو حقل ترقيم تلقائي

TheName

TheDate

TheAddress

يكون الاستعلام بالشكل التالي (عبارة SQL )

INSERT INTO Tbl1 ( TheNumber, TheName, TheDate, TheAddress )
SELECT DMax('[TheNumber]','[Tbl1]')+1 AS ExprNumber, Tbl1.TheName, Tbl1.TheDate, Tbl1.TheAddress
FROM Tbl1
WHERE (((Tbl1.TheNumber)=[أدخل الرقم]));

مع الاسف الاخفاء بالكود ما يمنع الاستيراد

راجع مشاركتي في الرابط

http://www.officena.net/ib/index.php?showtopic=1499

عنوان الموضوع : إستيراد الجداول من قاعدة حتي لو كانت مخفية

صاحب الموضوع : فتى الوادي

اخوي فتى الوادي

السلام عليكم ورحمة الله وبركاته

هذا كود يسترد جداول اي قاعدة بيانات لو كانت مخفية

ومعه مثال له عسى الله ينفع به

' كود استيراد الجداول
  Dim dbsDB As Database
  Dim tdf As TableDef
  Dim I As Integer, TableNames As String
  Dim strPath As String
  Dim strPassWord As String
  strPath = "المسار"
  strPassWord = "كلمة المرور ان وجدت"
   strPassWord = ";pwd=" & strPassWord
   Set dbsDB = OpenDatabase(Name:=strPath, _
                            Options:=True, _
                            ReadOnly:=True, _
                            Connect:=strPassWord)
For Each tdf In dbsDB.TableDefs
    If Left(tdf.Name, 4) <> "MSys" Then
        DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, tdf.Name, tdf.Name, False
        I = I + 1
        TableNames = TableNames & vbCrLf & I & " - " & tdf.Name
    End If
Next
dbsDB.Close
Set dbsDB = Nothing
    MsgBox "تم استيراد عدد " & I & " جدول أسماءها " & TableNames, , ""

 ' كود لاظهرا الجداول لو كانت مخفيه
Dim dbsDB As Database
Dim tdf As TableDef
    Set dbsDB = CurrentDb
    For Each tdf In dbsDB.TableDefs
    If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 _
    And tdf.Attributes = 1 Then
            tdf.Attributes = tdf.Attributes - dbHiddenObject
    End If
    Next tdf
    Set dbsDB = Nothing

TransferAllTables22.zip

السلام عليكم

نموذج فيه مربعين نص txt1 و txt2

الاول للادخال والثاني للنتيجة

في خصايص المربع الاول txt1 في حدث بعد التحديث

Private Sub Txt1_AfterUpdate()
If Not IsNumeric(Nz(Me.Txt1, 0)) Then Exit Sub
If Nz(Me.Txt1, 0) Mod 8 <> 0 Then
Me.Txt2 = Nz(Me.Txt1, 0) + (8 - (Nz(Me.Txt1, 0) Mod 8))
Else
Me.Txt2 = Nz(Me.Txt1, 0)
End If
End Sub

والمثال المرفق فيه افكار قريبة

ChangeTo8_2.zip

أو

في حدث قبل التحديث

إذا كنت تبغى في السجلات الجديدة فيقط

Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord And IsNull(Me.cc) Then me.txtdate=Date
End Sub

وإذا في أي سجل يتعدل عليه

Private Sub Form_BeforeUpdate(Cancel As Integer)
me.txtdate=Date
End Sub

حيث txtdate هو مربع النص الذي تريد وضع التاريخ فيه

المثال فيه فتح ملف عن طريق ارتباط تشعبي أو بدون ارتباط تشعبي

openFile33.zip

المطلوب ان شاء الله بطريقتين

ممكن تحميل المثال ايضا من الرابط

http://www.pcpages.com/osama457/students22.zip

فايدة

الافضل عدم تمسية الحقول وعناصر التحكم بأسماء مثل Name او Date

لانها عبارات محجوزة وممكن تسوي مشاكل ، وبدل من ذلك ممكن تسميتها مثلا Name1 ، Date9 أو غير ذلك

students22.zip

عندي مشكلة في التحميل للمنتدى!!

هذا رابط للملف

http://www.pcpages.com/osama457/Text&Num2.zip