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

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

ضع الكود التالي بعد تحديث السعر Private Sub price_AfterUpdate() Me.priceDate.Value = Date Me.Note.Value = "تم تعديل السعر في اليوم :" & Date End Sub

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

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

frmSub مخصص لغرض نموذج القسم الرئيسي - موظفين - طلاب - اعدادات و أنت تريد العمل على برنامج بنموذج و صفحة رئيسية واحدة و بالداخل نماذج متداخله . صامته تفتح و تغلق بمجرد التبديل فيما بينها . و تعتبر من جمالية و فخامة قاعدة البيانات تفضل هذا تعديل على نموذج قسم الموظفين الرئيسي . و نموذج جديد للملف الوظيفي و FRMSECOND و أزرار مستقله للتنقل بين نماذج الموظفين وعدد اثنين نماذج لتجربة التنقل الملف الوظيفي لا يوجد به كود الموظف . قمت بالتعديل على الجدول هذه الفكرة من النماذج المتداخلة و عليك الأكمال حتى لو أردت أضافة 20 نموذج لعرض بيانات ثانوية و صور و مستندات للموظفين - يمكنك أنشاء frm ثالث على قسم ثانوي أذا كنت تحتاج ذلك مستقبلاً ShowHideSideBareRight -MSM.7z

فى انتظار ردكم بعد التجربة الان كل شئ صار يتم بدون اى تدخل من المستخدم E-Invoicing.zip

السلام عليكم ورحمة الله تفضل 1.xlsx

السلام عليكم ورحمة الله ضع الكود التالى فى حدث الورقة Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Long LR = Range("B" & Rows.Count).End(3).Row + 1 If Not Intersect(Target, Range("B8:B" & LR)) Is Nothing Then Range("B8:O" & LR).Sort key1:=Range("B8"), order1:=xlDescending End If End Sub

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

ههههههههه يالهنائى ومن جديد يعود استاذى الجليل ومعلمى القدير واخى الحبيب الاستاذ @أبو عبدالله الحلوانى ليضع اجاباته وافكارة الرائعة فة نفس التوقيت الذى اقدم به افكارى المتواضعة جعلكم الله سباق بالخير استاذى وجزاكم الله خيرا على فكرتم الرائعة بوضع الاكواد فى روتين عام

السلام عليكم ورحمة الله وبركاته وانا ايضا اشارك استاذنا أبو خليل ما قال ففهم السؤال هو نصف الاجابة كما قيل ولكن اعتقد ان الأخ عمر يريد ان يضيف سجلات متعددة الي الجدول بنفس البيانات ويكون المتغير هو الرقم المتسلسل وعدد السجلات المطلوبة هو الرقم الذي يحدده في النهاية. ان كان هذا هو المطلوب فخذ تلك الوحدة النمطية وجرب ووافنا بالنتائج Public sub GenrateRecords(byval tbl as string,byval Rfrist As byte,byval Rend As byte) Aim rec As Recordset,n as byte set rec = CurrentDb.OpenRecordset(tbl, dbOpenDynaset, dbSeeChanges) With rec for n = Rfrist To Rend 'هنا رقم اول سجل وآخر سجل تريد ادراجه .AddNew !field_ID = "String" & n 'string = البادئة النصية التي تريد !field1 = control1 'بدأ من هذا السطر اسماء الحقول في الجدول وما يقابلها بالنموذج !field2 = control2 !field3 = control3 !field4 = control4 .update next end with End Sub وتستدعيها هكذا Call GenrateRecords ("Table Name",1,15) بعد تغير ما يلزم تغيرها بالوحدة حسب مسميات الحقول لديك

السلام عليكم ورحمة الله وبركاته وبها نبدأ اخى الكريم صاحب السؤال هذه الملف موجود في موقعه الرسمي هنا كل ما عليك الا ان تضغط download سوف تاتى لك مكان تكتب فيه اسمك والاميل الذي سوف يرسل لك الرابط عليه وستجد الاكواد ظاهرة ليست محميه

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

وعليكم السلام ورحمة الله وبركاته عدل xlDescending الى xlAscending

من فضلك لابد من رفع الملف نفسه حتى تتمكن الأساتذة من مساعدتك ... فلايمكن المساعدة بدون رفع ملف مدعوم بشرح كافى عن المطلوب !!!

اليوم كنت مستعجل بخصوص التعديل . . . هذه النسخة . . هادئة . حذفت منها بعض الأزرار و الأيقونات و الأكواد ما عليك سوى التوكل على الله و أطلاق العنان للتصميم الجديد لبرنامجك لا تنسى المعيار للأستعلامات . و أخفاء خلفية الأكسيس . و جعل جميع النماذج هادئة حتى تتماشى مع طبيعة عملك و إن شاءالله أبو جودي ما يمر على المشاركة . بصراحة ما جرى على التصميم . خطيئة لا يسامح عليها ‏‏ShowHideSideBareRight (2) - MSM2.7z

اووووووووووف الان بعد كل هذا العناء😡 تحصلت على ملف من موقع طبعة المصحف الشريف جااااااااااهز hafsData_v18.xlsx

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

تفضل الصنف.accdb

طيب يا بشمهندس لازالت بعص النصوص عل شاكلة طغيانهم ..... انظر ....

بقي شيء يجب ضبطه .. بعد اضافة الصفر في عمود الرقم سيبقى اسم المكتب خالي وحين تنقر على مربع التحرير (المكتب ) في النموذج الفرعي لتختار المكتب سيظهر لك في اسفل القائمة سجل خالي .. وطبعا يجب الا يظهر ومعالجته هو ان تضع معيارا في الاستعلام الذي هو مصدر الصف تحت عمود الاسم العبارة التالية : Not Is Null ارفقت لك المثال بعد التعديل للاطلاع devicesdb4_0.rar

الان تم بحمد الله تعالى اصطياد كل الاخطاء والتعامل معها كما ينبغى والتعديل النهائى على قاعدة البيانات ملك آياديكم الان E-Invoicing v.4.0.3.zip

السلام عليكم ورحمة الله استخدم هذه المعادلة =IF(B1<=50;B1*1.5;(B1-50)*2.5+75)

روتين عام يتم تمرير النص اليه ليقوم بعمل تعريه للنص من اى اشكال او رموز او حرف غير الاحرف العربية يعنى نقدر نقول مع هذا الروتين وداعا لكل حركات ورموز التشكيل If strString & "" = "" Then Exit Function Dim lngCtr As Long Dim intChar As Integer For lngCtr = 1 To Len(strString) intChar = AscW(Mid(strString, lngCtr, 1)) If intChar = 32 Or _ intChar >= 1569 And intChar <= 1594 Or _ intChar >= 1601 And intChar <= 1610 Or _ intChar >= 1648 And intChar <= 1649 Then StripSpCharsOnly = StripSpCharsOnly & ChrW(intChar) End If Next lngCtr StripSpCharsOnly = Trim(StripSpCharsOnly) ونفس الروتين مع بعض التعديلات لعمل مصفوفات لاستبدال حركات تشكيل مخصصة Public Function StripSpChars(strString As String) As String If strString & "" = "" Then Exit Function Dim lngCtr As Long Dim intChar As Integer For lngCtr = 1 To Len(strString) intChar = AscW(Mid(strString, lngCtr, 1)) If intChar = 32 Or _ intChar >= 1569 And intChar <= 1594 Or _ intChar >= 1601 And intChar <= 1610 Or _ intChar >= 1648 And intChar <= 1649 Then StripSpChars = StripSpChars & ChrW(intChar) End If Next lngCtr Dim itm As Variant For Each itm In Array(ChrW("1649")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575")) Next For Each itm In Array(ChrW("1648") & ChrW("1604")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1575") & ChrW("1604")) Next For Each itm In Array(ChrW("1610") & ChrW("1648")) StripSpChars = Replace(StripSpChars, CStr(itm), ChrW("1610") & ChrW("1575")) Next For Each itm In Array(ChrW("1648")) StripSpChars = Replace(StripSpChars, CStr(itm), "") Next StripSpChars = Trim(StripSpChars) End Function

لأن الحركات الموجودة في الرسم العثماني للمطبعة لا يفهمها الكمبيوتر .... ولكن انظر هل هذا هو المطلوب ,,,,,

بعد أذن أبو جودي أعطيك فكرة أنا أعمل عليها أكثر من عشر سنوات ممتازة وعملية ويتطور البرنامج معاك ولا يقف عند حد معين الملف الوظيفي مرتبط مع الملفات الفرعية بعلاقة و بمفتاح أساسي . . أذاً لماذا لا تضع frm أخر على فورم البيانات الأساسية ومن خصائص frm تربط الحقول الرئسية و الحقول التابعه و تتحكم بالمصدر برمجياً . وتصمم لكل جدول فرعي نموذج مستقل و لكل نموذج زر مستقل على فورم البيانات الأساسية و الحدث بهذه الطريقة FRM2.SourceObject = "أسم النموذج" والمعيار للأستعلامات بهذه الطريقة - تأكد من تسمية frm [Forms]![FormUIRT]![frm].[Form]![text] - و تطبق الطريقة هذه على كل تصنيف بالبرنامج

ماشاء الله عليك، والله إنك مبدع تسلم الايادي على الشغل الحلو والمتقن الله يعطيك ألف عافية انت وجميع من شارك حملت المرفق All in one Runtimes وثبته بالجهاز وحملت قاعدة البيانات الاخيرة واشتغلت عندي من غير اي مشاكل او أخطاء وقراءة Qr Code صحيحة 100% ومتوافقة مع هيئة الزكاة والدخل والجمارك من تطبيقهم الخاص ومن جميع تطبيقات قراءة الفاتورة الالكترونية بارك الله فيك وبجميع الاخوة، الله يزيدك من علمه ويوسع برزقك

تم تجريب المرفق الأخير ويعمل بكفاءة وجزاكم الله خيرا

ان شاء الله اكمل اعتذر نسيت الموضوع لانشغالى

لاحظت ان قاعدة البيانات التى تعمل من خلال تمرير البيانات الى ملف تنفيذى والذى تم انشاءه من خلال الفيجوال دوت نت العمل بطئ نظرا لارسال البيانات واستقبال الكود المشفر من ملف نصى دوال الـ API احدثت مشاكل كع نسخة اوقيس 2007 وبالرغم من التعديل والتجربة بنجاح الا انه اصناء التعديل تم ملاحظة ان الانتى فايروس يحذف الملف التنفيذى ولما سبق تم بفضل الله سبحانه وبحمده تعديل المرفق ليعمل من خلال مكتبات الجافا بدون اى برامج خارجية كل الاكواد من خلال الاكسس فقط وبدون استخدام دوال الـ API فى انتظار ردكم بعد التجارب E-Invoicing.zip

جزانا الله واياكم وكل وامة محمد صل الله عليه وسلم خير الجزاء ان شاء الله رجاء لا تنسي التاشير على افضل اجابة

وعليكم السلام 🙂 او https://www.devhut.net/use-arrow-keys-to-navigate-continuous-form-records/ جعفر

وعليكم السلام في النموذج ... حدث عند مفتاح للاسفل ... ضع هذه الشيفرة وجرب .... واعلمنا بالنتيجة ... On Error GoTo HandleErrors Me.KeyPreview = True Select Case KeyCode Case vbKeyLeft SendKeys "^{TAB}", True Case vbKeyRight SendKeys "+{TAB}", True Case vbKeyDown SendKeys "^{PGDN}", True Case vbKeyUp SendKeys "^{PGUP}", True End Select Exit Sub HandleErrors: Select Case Err.Number Case 2105 KeyCode = 0 Case Else MsgBox "Error: " & Err.Number & " " & Err.Description End Select أو جرب هذا ايضا ..... On Error Resume Next Select Case KeyCode Case vbKeyDown If KeyCode = vbKeyUp Then DoCmd.GoToRecord , , acPrevious End If If KeyCode = vbKeyDown Then DoCmd.GoToRecord , , acNext End If Case vbKeyUp If KeyCode = vbKeyUp Then DoCmd.GoToRecord , , acPrevious End If If KeyCode = vbKeyDown Then DoCmd.GoToRecord , , acNext End If Case vbKeyReturn KeyCode = 0 End Select

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

يمكن تعديل المسار من خلال محرر الريجيستري قم بالضغط على زري الويندوز + R ثم اكتب regedit واضغط إدخال بما أنك تستخدم أوفيس 2019 انتقل إلى المسار التالي: Computer\HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\16.0\Outlook\Options (ملاحظة يمكنك نسخ المسار ولصقه مباشرة في محرر الريجيستري للانتقال مباشرة إلى المكان المراد) اضغط في الجهة المقابل بالزر الأيمن واختر (New) ثم String Value قم بتسميته DefaultPath اضغط عليه مرتين وضع مسار الملفات الذي تود أن يفتح عليه الأوت لوك عند رغبتك في حفظ المرفقات أغلاق محرر الريجيستري. وبهذا تكون انتهيت .. وفي المرات المقبلة عند الضغط على زر حفظ .. سيفتح لك مباشرة إلى مجلدك

متابع

شكرا ابا جود على هذا العمل الجبار خدمة نسخ الملفات اللازمة بجانب قاعدة البيانات لا تقدر بثمن جعله الله في موازين اعمالك عندي ملاحظة افادني بها احد الاخوة يقول : ملف ابو جودي الاول الذي يعتمد على الملف التنفيذي هو الذي يعمل اما الاخير هذا فانه ينقصه شيء ما اخونا يمسح الكيو آر بتطبيق آخر يقول انه هو الرسمي المعتمد وهذا رابطه وتعليق الأخ عليه _______________________________________________________________ https://play.google.com/store/apps/details?id=com.zatca.vat هذا برنامجهم الرسمي فيه كل شي فيه تحقق من الرقم الضريبي وفية بلاغ بالسجل التجاري او بالرقم الضريبي وفيه تعليمات بمعنى قارئهم الرسمي حمله وشوف _______________________________________________________________ طبعا انا جربت وطلع كلامه صحيح سوف ادرج صور للنتيجة ادناه التي تظهر الفاتورة فيها هي الملف الاول الذي يستخدم الملف التنفيذي اما الصورة الاخرى فهي نتيجة قراءة الملف الثاني الجافا الرسالة "" شكرا لمسح رمز الاستجابة السريعة تم مشاركة ... الخ """ يعني ان الماسح لم يقرأ جرب التطبيق الجديد على الملفين

السلام عليكم 🙂 ولو اني تأخرت عن الركب ، ولكن قد تكون مشاركتي مفيدة 🙂 المشكلة الموجودة في الكلمات العربية ، وفي بعض انواع الخط الخاصة (مثل خط القرآن الكريم) ، هو اننا لا نعرف ما هي التشكيلات الموجودة ، ولا رقمها ، وبمل اننا نتعامل مع اللغة العربية ، فللحصول على رقم الحرف/التشكيلة ان نستخدم AscW و ChrW (رجاء ملاحظة وجود W) ، عليه ، عملت هذه الدالة لإستخراج جميع الحروف/التشكيلات الموجودة في حقل nass في الجداول b4 و b5 و b6 ، وحفظها في جدول خاص بها tbl_Tashkeela ، في حقل Tashkeela (لا يقبل التكرار) 🙂 هذه هي الدالة: Function Save_Tashkeela() On Error GoTo err_Save_Tashkeela Dim rstTashkeela As DAO.Recordset Dim rstTables As DAO.Recordset Dim i As Integer, j As Integer Set rstTashkeela = CurrentDb.OpenRecordset("Select * From tbl_Tashkeela") For i = 4 To 6 Set rstTables = CurrentDb.OpenRecordset("Select nass From b" & i) Do Until rstTables.EOF For j = 1 To Len(rstTables!nass) rstTashkeela.AddNew rstTashkeela!Tashkeela = Mid(rstTables!nass, j, 1) rstTashkeela!Tashkeela_ChrW = AscW(Mid(rstTables!nass, j, 1)) rstTashkeela.Update Next j rstTables.MoveNext Loop Next i Exit_Save_Tashkeela: rstTables.Close: Set rstTables = Nothing rstTashkeela.Close: Set rstTashkeela = Nothing MsgBox "Done" Exit Function err_Save_Tashkeela: If Err.Number = 3022 Then 'duplicate found Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . ولأننا سنستخدم هذه الدالة مرة واحدة (او حنى عدة مرات) ، فالاسهل لي ان اناديها من الكود هكذا (طبعا يمكن مناداتها من اي مكان (ولكن ليس من الاستعلام ، فمناداتها مرة واحد تكفي لتغطية جميع حروف الجداول ، بينما الاستعلام سياديها بعدد السجلات ، وهذا مضيعة للوقت ولا فائدة منه) ، ورجاء ملاحظة ان علامة الاستفهام هي باللغة الانجليزية 🙂 . ونتيجة الجدول: جعفر 1341.ارشيف2.mdb.zip

ارشيف2.mdb

السلام عليكم . هذا صحيح ، ولكن في نهاية الدالة تستطيع تختار النطاق Range او الورقة/sheet ، فعليه يمكنك ان تعيد الامر اكثر من مرة ، كل مرة لورقة اكسل اخرى (لاحظ اسماء الـSheet): DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet1$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet2$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet3$" . ولكن هذا الامر يتطلب منا ان نعرف عدد الاوراق/Sheets ، واسمائها ------------------------------------------------------------------------------------------------------------------------ والآن لشرح ما عملته انا: 1. عملت جدول اسمه tbl_Sheets ، لإدخال جميع المعلومات في جميع الاوراق/Sheets: . وعن طريق الكود (الكود سيكون في نهاية الموضوع) ، يأخذ البيانات ، فيصبح: . ثم يأتي الكود مرة اخرى ، فيملئ حقل ID لكل علامة: . ثم عملت استعلام جدولي CrossTab ، والذي به نستطيع ان نجعل بيانات احد الاعمدة عبارة عن اعمدة متفرقة ، يعني الحقل F1 ، اردنا ان نجعل كل مادة عبارة عن عمود مستقل): . وهذه نتائجه: . والان الى عمل استعلام آخر ، لجمع كل هذه السجلات: . فاصبحت: . الآن وقد اصبحت البيانات جاهزة لإلحاقها بالجدول النهائي Degrees ، نعمل استعلام الحاقي: . والكود الذي يقوم بكل العمل: Private Sub ImportData_Click() 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet1$" 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet2$" 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet3$" Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim strPathFile As String, strTable As String Dim strPassword As String ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = False ' Replace C:\Filename.xls with the actual path and filename strPathFile = Me.txtPath ' "C:\Filename.xls" ' Replace tablename with the real name of the table into which ' the data are to be imported strTable = "tbl_Sheets" '"tablename" ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (e.g., strPassword = vbNullString) strPassword = vbNullString '"passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _ strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing ' Import the data from each worksheet into the table For lngCount = colWorksheets.Count To 1 Step -1 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" Next lngCount ' Delete the collection Set colWorksheets = Nothing '--------------------------------- ' importing is finished 'now organize the table, by adding the ID to all the group Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Sheets") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If rst!F1 = "رقم الهوية" Then 'And Len(rst!ID & "") = 0 Then myID = rst!F2 rst.Edit rst!ID = myID rst.Update Else rst.Edit rst!ID = myID rst.Update End If rst.MoveNext Next i rst.Close: Set rst = Nothing 'append the data DoCmd.SetWarnings False DoCmd.OpenQuery "qry_Append_Sheets" DoCmd.SetWarnings True MsgBox "Done" ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile End Sub . . ولكن ، يجب عليك ان تحذف بيانات الجداول Degree و tbl_Sheets قبل ان تقوم بأي عمل جعفر 275.ImportDegrees.accdb.zip

أستاذي الكريم / ابا عمر جزانا واياكم والمسلمين وسوف أرسل لكم البرنامج قريبا بإذن الله ولكن عندما أوقم بتجهيزه وأسأل الله تعالى أن لا تنسانا دائما من دعواتكم ولكم بالمثل

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

عندي سجل به بيانات في نموذج اريد عند تغيير سعر المنتج يتغير التاريخ تلقائيا لتاريخ اليوم و يكتب في خانة الملاحظات(تم تعديل السعر في اليوم)