نجوم المشاركات

الله أكبر ما شاء الله عليكم والله مش عارف أرد جميلكم كيف ولا أملك سوى الدعاء لكم بالتوفيق والبركة الدائمة الله آمين جزاكم الله خيراً استاذ علي جزاكم الله خيراً استاذ سليم جزاك الله خيراً استاذ علي ... لكن هل من شرح بسيط لو أحببت أن أغير من هذه البيانات لبيانات أخرى كيف أنفذها من خلال طريقتك جزاك الله خيراً

بعد اذن اخي علي هذا الكود Option Explicit Sub filter_for_ME() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim S_sh As Worksheet: Set S_sh = Sheets("المرحلة الابتدائية") Dim T_sh As Worksheet Dim My_Table As Range: Set My_Table = S_sh.Range("A1").CurrentRegion For Each T_sh In Worksheets If T_sh.Name <> S_sh.Name Then With T_sh .Cells.ClearContents .Range("z1") = "Status": .Range("z2") = T_sh.Name My_Table.AdvancedFilter Action:=2, _ CriteriaRange:=.Range("z1:z2"), _ CopyToRange:=T_sh.Range("A1") .Range("z1:z2") = vbNullString End With End If Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف مرفق سداد_Salim.xls

وعليكم السلام تفضل لك ما طلبت سداد المصروفات.xlsm

اغلب اعضاء المنتدى تواجههم مشكلة عند الضغط على زر معين لا يعمل او لا ينفذ الامر لحل مثل هكذا مشكلة هناك طريقتين بيسطتين : 1- ضع الكود الذي فيه مشكل بين عبارتي on error goto رمز معين : الكود الخاص بالمستخدم الذي فيه المشكلة msgbox err.description الطريقة الثانية وهي الافضل . اذهب الى النموذج الذي فيه الكود الذي لا يعمل وادخل على اية اداة تحكم ( زر -مثلا) الذي فيه المشكلة اذهب الى شريط المعلومات واختر الامر debug ,ومن ثم الامر compiler database سيقوم معالج الاكسيس بالكشف عن الاخطاء في برنامج . ارجوا من اخوتي الاستفادة من هذه المعلومة البسيطة قال النبي محمد (ص) : زكاة العلم نشره . صدق رسول الله (ص)

حياك الله استاذ صالح لو حبيت اعرف رصيد المخزن في وقت سابق وقبل عملية شراء معينة ؟ الجدول الواحد يساعدني ان اعرف الرصيد في اي وقت لان الحركة مستسلسلة برقم فريد سواء للشراء او البيع . لو جدولين كيف ستتحكم باوامر الاس كيو ال ؟ وهنا سيكون تسلسل فاتورة شراء هو نفسه تسلسل فاتورة بيع ؟ ممكن تفيدنا استاذ صالح بلغة الاس كيو ال العامة بلغتنا : بمعنى في الجدول الواحد سنقول اجمع مواد الشراء واطرح منها مواد المبيع بشرط رقم الحركة اقل من كذا . هنا استطيع بسهولة معرفة الرصيد حتى لو بعد سنة . تحياتي

هذا رابط الموضوع السابق المختصر الفكرة هي تأسيس لعملية البيع والشراء لعملاء معتمدين باقل قدر من الكائنات ، والفكرة تم تنفيذها بــ 3 جداول أساسية فقط : راس الفاتورة _ التفاصيل _ المدفوعات . كثير منكم سيقول نعلم هذا ولم تأت بجديد ، وأعلم ذلك ولكن الحال في غالب الامثلة والمواضيع المنتشرة في هذا المنتدى وغيره تختلف وفيها الإلزام بما لا يلزم . وموضوعي هنا نسخة مطابقة من الرابط السابق ولكني احببت افراده بموضوع وعنوان مستقل لعدة اسباب : 1- وجود فكرة جديدة من بنات افكاري تساعد عند عمليات الادخال ، ومن الممكن وجود احد سبقني الى هذه الفكرة في هذا المنتدى او غيره فهنا اقدم اعتذاري له ابتداءً ولتعلموا انما هو توارد خواطر . 2- جميع من مر على الموضوع السابق وفهم الفكرة لن يتوقع تغير متميز لذا لن ينشط في المتابعة وفي تصفح المثال الجديد 3- تلافي جميع المشكلات في الملاحظات السابقة خاصة التي يستعصي او يصعب حلها الفكرة هي جعل جميع النماذج غير منضمة والحاق البيانات باستخدام الكود ، وهذه ليست جديدة ولكن الجديد هو استخدام جدول وسيط مؤقت لرصد تفاصيل الفاتورة buySel.rar

ليس هكذا شوف نموذج date04 للتدريب.accdb

اتفضل هذا حسب طلبك لتعم الفائده نعمل وحده نمطيه Option Compare Database Public myfile As String Public Function delTbl() Dim strdb As String Dim dbs As DAO.Database Dim tdf As TableDef strdb = Application.CurrentProject.Path & "\bb" Set dbs = OpenDatabase(strdb) On Error Resume Next For Each tdf In dbs.TableDefs If Not (left(tdf.name, 4)) = "MSys" Then dbs.Execute ("delete * from " & tdf.name) End If Next Set dbs = Nothing End Function Public Function delRelTbl() Dim strdb As String Dim dbs As DAO.Database Dim tdf As TableDef strdb = Application.CurrentProject.Path & "\bb" Set dbs = OpenDatabase(strdb) On Error Resume Next With dbs For Each rel In .Relations .Relations.delete rel.name Next .Relations.Refresh End With dbs.Close Set dbs = Nothing End Function Public Function ImportTbl() Dim db As Database Dim StrSql As String Dim tdf As TableDef Dim strPath As String Dim BackDB As DAO.Database strPath = Application.CurrentProject.Path & "\bb" Set BackDB = OpenDatabase(strPath) For Each tdf In BackDB.TableDefs If Not (left(tdf.name, 4)) = "MSys" Then BackDB.Execute ("delete * from " & tdf.name) StrSql = "INSERT INTO " & tdf.name & " SELECT " & tdf.name & ".* FROM " & tdf.name & " IN '" & myfile & "';" BackDB.Execute (StrSql) End If Next tdf Set db = Nothing End Function Function ImportRelations(DbName As String) As Integer Dim ThisDB As DAO.Database, ThatDB As DAO.Database Dim ThisRel As DAO.Relation, ThatRel As DAO.Relation Dim ThisField As DAO.Field, ThatField As DAO.Field Dim cr As String, i As Integer, cnt As Integer, RCount As Integer Dim j As Integer Dim ErrBadField As Integer cr$ = Chr$(13) RCount = 0 Set ThisDB = DBEngine.Workspaces(0).OpenDatabase(Application.CurrentProject.Path & "\bb") Set ThatDB = DBEngine.Workspaces(0).OpenDatabase(DbName$) For i = 0 To ThatDB.Relations.Count - 1 Set ThatRel = ThatDB.Relations(i) Set ThisRel = ThisDB.CreateRelation(ThatRel.name, _ ThatRel.Table, ThatRel.ForeignTable, ThatRel.Attributes) ErrBadField = False For j = 0 To ThatRel.Fields.Count - 1 Set ThatField = ThatRel.Fields(j) Set ThisField = ThisRel.CreateField(ThatField.name) ThisField.ForeignName = ThatField.ForeignName On Error Resume Next ThisRel.Fields.Append ThisField If err <> False Then ErrBadField = True On Error GoTo 0 Next j If ErrBadField = True Then Else On Error Resume Next ThisDB.Relations.Append ThisRel If err <> False Then Else RCount = RCount + 1 End If On Error GoTo 0 End If Next i ThisDB.Close ThatDB.Close ImportRelations = RCount End Function ثم نعمل كود في زر الامر On Error GoTo MyErr Dim wrkJet As Workspace Dim AbA As Database Dim tbl As TableDef Dim Path, myfile As String Dim varItem As Variant With Application.FileDialog(msoFileDialogFilePicker) .Title = "اختر الملف المراد نسخه" If .Show Then For Each varItem In .SelectedItems myfile = varItem Next varItem End If End With If Len(myfile & "") > 0 Then If MsgBox("يترتب على استرجاع البيانات المحددة حذف البيانات الحالية" _ & vbCrLf & "ويستحسن عمل نسخة من البيانات الحالية قبل الاسترجاع " _ & vbCrLf & vbCrLf & "هل أنت متأكد من أنك تود استبدال البيانات الحالية بالبيانات المسترجعة " _ , 590132, "تنبيه ") = 7 Then Exit Sub Set wrkJet = DBEngine.Workspaces(0) Set AbA = wrkJet.OpenDatabase(myfile, False, False, ";PWD=123456") Dim StrSql As String Dim tdf As TableDef Dim BackDB As DAO.Database Dim strPath As String strPath = Application.CurrentProject.Path & "\bb" Set BackDB = OpenDatabase(strPath) For Each tdf In BackDB.TableDefs If Not (left(tdf.name, 4)) = "MSys" Then delRelTbl BackDB.Execute ("delete * from " & tdf.name) StrSql = "INSERT INTO " & tdf.name & " SELECT " & tdf.name & ".* FROM " & tdf.name & " IN '" & myfile & "';" BackDB.Execute (StrSql) End If Next tdf MsgBox " تـــم استرجـــــاع بيــــانات النسخـــــــه المحــــــدده ", vbInformation, Space(5) & " : استرجاع بيانات " End If CurrentDb.TableDefs.Refresh Call ImportRelations(myfile) CurrentDb.Close Me.Refresh

وعليكم السلام والرحمة والاكرام تفضل اخي انا تعبت لان كنت بدور زيك بس الحمد لله حليت الموضوع ويا رب تقدر تستفيد منه الامر معمول بالكود fatoura33.rar

لاستعمال الماكرو الذي كتبته لك يجب كتابة كلمة Status في الخلية G1

كل الشكر استاذ سليم

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

وعليكم السلام المصيبة كان في سطر الاول وهو فتح نموذج باسم فورم وليس ليس اي نموذج باسم فورم فقط غيرت الى فورم 1 شوف من هذا DoCmd.OpenForm "form", , , , , acHidden الى هذا DoCmd.OpenForm "form1", , , , , acHidden database1 (1).accdb

اتفضل Private Sub Command0_Click() Dim tdf As TableDef Dim i As Integer, TableNames As String Dim strPath As String strPath = Application.CurrentProject.Path & "\b.mdb" ' مسار قاعدة البيانات التي بها الجدول For Each tdf In CurrentDb.TableDefs If Left(tdf.Name, 4) <> "MSys" Then ' DoCmd.DeleteObject acTable, tdf.Name DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, tdf.Name, tdf.Name, False i = i + 1 TableNames = TableNames & vbCrLf & i & " - " & tdf.Name End If Next End Sub

أخي @محمد احمد لطفى يمكن عملها ولكن كنموذج مستمر .....

بارك الله فيكم وجزاكم الله خير الحقيقه انا اوويد فكرة الاخ شفان جدول واحد فيه جميع عمليات البيع والشراء واسهل في الاستعلامات واخراج التقارير وطريقتي اني اميز سجلات البيع والشراء بحقل يكون فيه رمز لسجل البيع ورمز لسجل الشراء مثلا اي سجل بيع يحمل رمز B واي سجل شراء يحمل زمز S

أستاذى @kanory هل يمكن عمل نفس الطريقة فى نموذج

تفضل ضع مجلد الصور في الدرايف C photo.rar

كل الشكر و الاحترام

اشكركم جميعا على الردود والمشاركات ابو ياسين المشولي حربي العنزي وعطوني رايكم في العمل او في فكره جديدة افيدوني بها accdb

راجع هذا اضغط هنا

اخوانى تحياتى واحترام لكم جميعا ممكن تلميذكوا يدلو بدلوه اولا لانى اعمل فى مجال المحاسبة وحاولت منذ سنوات فى هذا الموضوع بالذات وخاصة مجال البيع والشراء ده مجرد رأى عمل جدول رأس للشراء وفى نفس الوقت مرتجع الشراء وجدول اخر لرأس البيع ومرتجع البيع والجدول الثالث للحركة ويرتبط بالجدولين . ولان التعامل سواء فى الشراء او البيع ومرتجعاتهم يكون على سلعة بعينها فى جدول الحركة يكون فيه حقل كمية واردة يستخدم فى الشراء وفى مرتجع البيع وحقل كمية صادرة فى البيع ومرتجع الشراء فمن خلال الحقلين نعرف الرصيد وبالاستعلام ايضا وهنا فى هذا الصرح امثلة كثيرة لاساتذتنا الى علمونا الاكسس

هذا تطبيق ومحاولة رمهانية متمنيا لكم التوفيق Private Sub Form_Current() Me.Parent!total = Me.ActiveControl End Sub Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) On Error Resume Next Set rs = Me.RecordsetClone: rs.MoveLast: rs.MoveFirst a = rs.GetRows(rs.RecordCount) If KeyCode = 16 Then For ii = 0 To Me.SelWidth - 1 For i = 0 To Me.SelHeight - 1 xsum = xsum + a(Me.SelLeft + ii - 2, Me.SelTop + i - 1) Next i Next ii End If Me.Parent!total = xsum End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next Set rs = Me.RecordsetClone: rs.MoveLast: rs.MoveFirst a = rs.GetRows(rs.RecordCount) For ii = 0 To Me.SelWidth - 1 For i = 0 To Me.SelHeight - 1 xsum = xsum + a(Me.SelLeft + ii - 2, Me.SelTop + i - 1) Next i Next ii Me.Parent!total = xsum End Sub قاعدة البيانات1.accdb

لو اصبح لكفيل مشتري .. والعكس لو اصبح المشتري كفيل ؟؟؟ تحياتي

حياك الله الاستاذ شيفان وحيا الله الجميع رايي المتواضع هو ذكرت انت جدول الحركات واعتقد تقصد تفاصيل الفاتورة وهي المواد وبها العدد والسعر وهنا اعتقد انه جدول واحد ولايوجد خلاف لان المادة والعدد والسعر يصلحان للقصد بالبيع او الشراء ويبين الحركة هو راس الفاتورة . وهنا اعتقد ان السؤال المفروض هو هل راس الفاتورة يكون جدولين ام جدول واحد اي جدول للمشتريات وجدول للمبيعات وهنا رأيي ان يتم دمج الجدولين بجدول واحد ويتم تمييز نوع العملية هل هي شراء ام بيع وهنا وقفة : سيكون لديك طبعا حقل العميل خاص بالمبيعات وحقل المورد خاص بالمشتريات ..اي في حركة البيع سيكون حقل المورد فاضي وفي الشراء سيكون حقل العميل فاضي .. ممكن دمج الحقلين بحقل واحد ولكن في الاستعلامات وجميع التقارير تميزها بحركة احترافية وهي اذا كان نوع الفاتورة شراء فان الرقم الموجود هو مرجع لجدول الموردين واذا كانت بيع فان الرقم بهذا الحقل مرجع لجدول العملاء. وميزة جدول واحد هو كما ذكرت انت بسهولة استخراج الرصيد عند كل حركة لان رقم الحركة الاب سيكون معروف في التفاصيل لاي حركة تمت سواء شراء ام بيع . طبعا هنا الهدف من جدول واحد هو الحصول على مرجع فريد لكل عملية شراء او بيع لانه لوكانت جدولين فيمكن ان يتشابه رقم فاتورة شراء مع رقم فاتورة بيع . ملاحظة : في قواعد البيانات اوراكل هناك شي اسمه السكونس وهو عمود لتوليد تسلسل فريد ويمكن ربطه باي جدول وهنا تضمن ان التسلسل ينشأ بعيدا عن الجداول ومستقل ويتم اخذ قيمته وقت الحاجة . للاسف الاكسس لايوجد به هذه الميزة ولكن يمكن التلاعب بان تنشئ جدول مستقل خاص وبه عمود ترقيم تلقائي ويصبح هو التسلسل لفواتير البيع وفواتير الشراء وهنا يمكن ان يصبح لديك راس الفاتورة جدولين واحد للشراء والاخر للبيع ولكن رقم الفاتورة بالجدولين يتم اخذهم من التسلسل المنشأ في جدول التسلسل . خلاصة : جدول واحد لراس الفاتورة وبه نوع الحركة وعمودين واحد للعميل يربط جدول العملاء والاخر المورد ويربط بجدول الموردين + جدول الحركة وبه تفاصيل الفاتورة. هناك طبعا تحدي دائما يواجه المبرمجن للنظم المحاسبية وهي لو ان المورد هو عميل عندي اي حساب عميل ومورد بنفس الوقت وهذه اعتقد مسألة اخرى للنقاش ولكي لا يتشعب الموضوع . تقبل تحياتي والموضوع منور اكثر بمشاركة الاستاذ محمد طاهر والذي نستغلها فرصة ونقدم له اجمل تحية

اتفضل اليك هذا Private Sub Command0_Click() Dim NameTblimport As String Dim txtpathfile As String NameTblimport = "Table" ' اسم الجدول المراد استيراده txtpathfile = Application.CurrentProject.Path & "\b.mdb" ' مسار قاعدة البيانات التي بها الجدول DoCmd.DeleteObject acTable, NameTblimport DoCmd.TransferDatabase acImport, "Microsoft Access", txtpathfile, acTable, NameTblimport, NameTblimport, False End Sub DeleteAndImportTableFromAccess

هناك 2 طريقة امامك 1 / حذف الجدول الاول و ادراج اي امبورت الجدول الثاني اذا الجدول الثاني يكون مصممة بالكسس او اكسل مثلا 2 / حذف البيانات في جدول عندك و ادراج البيانات فقط اللي في جدول الثاني اي امبورت البيانات فقط لكن حسب ما اشوف ان الطريقة الثانية احسن واذا تبحث في المنتدى راح تشوف الموضوعات عن امبورت