صالح حمادي

تفضل هذا هو شكل الكود الآن: On Error Resume Next Dim req As String DoCmd.DeleteObject acTable, "zaher11" Dim PathImg As String Dim fpath As Variant With Application.FileDialog(3) .Title = "ÇÎÊÑ ÇáÊÞÑíÑ" .Filters.Clear .Filters.Add "txt", "*.txt" .AllowMultiSelect = False .InitialFileName = "d:\" If .Show = -1 Then PathImg = .SelectedItems(1) End If End With '----------------------------------------------------------- DoCmd.TransferText acImportDelim, (";"), "zaher11", PathImg req = "Delete From zaher11 where isnull(f1);" DoCmd.SetWarnings False DoCmd.RunSQL req DoCmd.SetWarnings True '---------------------------------------------------------------- Dim rst As DAO.Recordset Dim i As Integer, RC As Integer Set rst = CurrentDb.OpenRecordset("SELECT * FROM [zaher11]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If DCount("*", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") > 0 Then Me.frmSub_sra.SetFocus DoCmd.GoToRecord , , acNewRec [frmSub_sra].Form![ID_Sanf] = Left(rst!f1, 11) [frmSub_sra].Form![Sanf] = DLookup("Sanf", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") [frmSub_sra].Form![Alkmiah] = Right(rst!f1, InStr(1, rst!f1, " ")) End If rst.MoveNext Next i ادارح الاصناف بضغطت زر.rar

و فيك بارك الله أخي الكريم

السلام عليكم استعمل هذا الكود: On Error Resume Next Dim req As String DoCmd.DeleteObject acTable, "zaher11" Dim PathImg As String Dim fpath As Variant With Application.FileDialog(3) .Title = "اختر التقرير" .Filters.Clear .Filters.Add "txt", "*.txt" .AllowMultiSelect = False .InitialFileName = "d:\" If .Show = -1 Then PathImg = .SelectedItems(1) End If End With '----------------------------------------------------------- DoCmd.TransferText acImportDelim, (";"), "zaher11", PathImg req = "Delete From zaher11 where isnull(f1);" DoCmd.SetWarnings False DoCmd.RunSQL req DoCmd.SetWarnings True '---------------------------------------------------------------- Dim rst As DAO.Recordset Dim i As Integer, RC As Integer Set rst = CurrentDb.OpenRecordset("SELECT * FROM [zaher11]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If DCount("*", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") > 0 Then 'هنا تكتب كود إضافة السلعة للفاتورة End If rst.MoveNext Next i ادارح الاصناف بضغطت زر.rar

أحسنت أخي الكريم بالنسبة للمثال الذي أرفقته لك هو من أجل توضيح الفكرة و يمكنك أن تتحكم بها كما تشاء في هذه الحالة إستعمل الدالة Mid مكان الدالة Left هذه تستعمل في نوع محدد من الباركود EAN-13 نعم هذه فكرة جيدة و ربما لو تستعمل خانة واحدة أفضل مثلا الرقم الذي يبدأ بــ 1 يدل على أصناف الحبة و الرقم الذي يبدأ بـــ: 2 يدل على أصناف الوزن و لي تجميعية جيدة بها العديد من الأكواد تستطيع الإستفادة منها: بالتوفيق إن شاء الله

السلام عليكم عيدكم مبارك و كل عام و أنتم بألف خير إن شاء الله حسب رأي المتواضع أنك تستخدم الوزن سوف يكون أفضل أما بالنسبة للكود سوف يكون كالتالي: DoCmd.GoToRecord , , acNewRec [sub_tbl6].Form![code_article] = Left(Me.code_ar, 6) [sub_tbl6].Form![article] = DLookup("article", "tbl1", "code_art='" & [sub_tbl6].Form![code_article] & "'") [sub_tbl6].Form![Qte] = Right(Me.code_ar, Len(Me.code_ar) - 6) / 1000 [sub_tbl6].Form![prix] = DLookup("prix", "tbl1", "code_art='" & [sub_tbl6].Form![code_article] & "'") [sub_tbl6].Form![total] = [sub_tbl6].Form![prix] * [sub_tbl6].Form![Qte] Me.Refresh أدخل رمز السلعة أول 6 أرقام تمثل رمز السلعة و الباقي يمثل الوزن و إليك مثال تطبيقي من أجلك تقسيم_الباركود.rar

السلام عليكم لقد قمت بتغيير نوع الحقل الطول تقسيم الوزن من عدد صحيح طويل إلى مزدوج لكي يقبل الأعداد العشرية و قمت بتغيير أسماء مربعات النص إلى a, b و c و هذا هو التعديل: القياس.rar

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

شكرا جزيلا أخي @king5star موضوع مهم جدا

الأخ عبد اللطيف يقصد ما هو نوع ملف قاعدة البيانات

السلام عليم استعمل هذا الكود خلف زر Me.List1.RemoveItem Me.List1.ListIndex بحيث List1 هو اسم مربع القائمة

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

سؤال مغاير للموضوع أخي يجب عليك فتح موضوع جديد لسؤالك

أهلين أخي فين هذا الغياب

السلام عليكم جرب هذا المرفق If CurrentRecord < Me.c Then DoCmd.GoToRecord , , acNext End If زر_التنقل.rar

ممتاز صديقي الكود حاليا يعمل بشكل جيد الكود التالي أنا أستعمله منذ يومين و لم يظهر لي أي مشكل بعد لكن لا أدري لست مرتاحا له كثيرا. Dim WshShell As Object Set WshShell = CreateObject("wscript.shell") WshShell.SendKeys "{End}" Set WshShell = Nothing و الظاهر أنني سوف أستعمل مثالك ما لم يظهر أي مشكل شكرا جزيلا صديقي العزيز

مين لها غيرك يا حبيب القلب راح جرب و خبرك

السلام عليكم عندما أستعمل الأمر sendkeys لأحد مفاتيح لوحة المفاتيح يقوم بإغلاق زر تشغيل الأرقام لا أدري ما هو السبب في ذلك هناك بعض الحيل لتفادي هذا المشكل لكن لا تنجح دائما هل هناك تفسير او حل لهذه الظاهرة؟

العفو أخي

حلوة طلة الأحبة

السلام عليكم الكود التالي يمكنك من معرفة هل يوجد اختصار على سطح المكتب أو لا: Dim curPath As String curPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\tt.lnk" If Len(Dir(curPath, vbDirectory)) <> 0 Then MsgBox 1 Else MsgBox 0 End If اسم الاختصار هو tt إذا كان هناك اختصار تظهر رسالة بها 1 و إذا لم يكن هناك إختصار تظهر رسالة بها 0 جرب الكود و أطلعنا على النتيجة

السلام عليكم الخطأ سببه أنك وضعت كود يقوم بإغلاق نموذج data06 و هو يحمل التاريخ الأول والثاني جرب أحذف هذا الكود و جرب

إن شاء الله راح أضيفها للبرنامج أخي لكن بعد أن أنهي العمل الذي بين يدي مدة 4 أو 5 أيام

السلام عليكم أضف مرفق للتعديل عليه

السلام عليكم اتبع الخطوات الموجودة بالصور: الكتابة رأسي من أعلى لأسفل.mdb

نعم لقد طلبه مني أحد الإخوة من قبل و وعدته بأن أنجز ذلك، بعد أنتهي من أعمالي التي تمنعني من الدخول كثيرا للمنتدى. نعم يمكن ذلك لاحظ هذا المرفق في في قائمة ملف لا يوجد وميض و بقية القوائم يوجد وميض أدخل على الأكواد البرمجية و ستعرف السر في ذلك مثال.rar