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

نعم أستاذ شيفان.. إليك الوظيفة التالية Function GetNumbersOnly(SText) Dim Numbers For i = 1 To Len(SText) If IsNumeric(Mid(SText, i, 1)) Then Numbers = Numbers & Mid(SText, i, 1) End If Next GetNumbersOnly = Trim(Numbers) End Function New Microsoft Access Database.zip

اليك هذا الحل لعل يفيدك اولا عملت استعلام للاسماء اللي في جدول الموظفين وليس موجودين في جدول الرواتب وهذا هو الاستعلام SELECT persons.* FROM persons LEFT JOIN Salary ON persons.[EmpNumber] = Salary.[EmpNumber] WHERE (((Salary.EmpNumber) Is Null)); وعملت نموذج عليه واستخدمت هذا الكود لزر Private Sub Command0_Click() Dim MyCount As Integer MyCount = DCount("*", "personsWithoutMatchingSalary") If MsgBox("هناك ( " & MyCount & " ) اسماء لم يكن في جدول الرواتب .. هل تريد ان تنظر الى اسماءهم ", vbYesNo, "تنبيه") = vbYes Then DoCmd.OpenForm "personsWithoutMatchingSalary", acNormal End If End Sub اليكي المرفق bmn.rar

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

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

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

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

:: ههههه تنادي العرب .... فلا من مجيب ؟! وقد لبى ندائك الكرد شكرا @Shivan Rekany

سلمت الايادي استاذ @Shivan Rekany وجزاك الله خير وزادك من علمه وفضله .

من باب التذكرة والتسهيل عليك بدلا من الخوض فى المشاركات السابقة لمعرفة المشاكل تفضل المشاكل لتعمل عليها : 1- تعديل قيمة زد فاليو لا يعيد حساب متوسط السعر ولا رصيد بعد الحركة. 2-عند اضافة منتج فى نموذج ترانس توب لو كود المنتج رقمى احيانا لا يستدعى السعر الخاص به ويعامله معاملة المكونات يعنى اضافة وصرف فقط . 3- عند استدعاء سعر من جدول المنتجات اذا كان الرقم 1.5252525255 يكتبه فى متوسط السعر 1 فقط ويتجاهل المنازل العشرية فى حين انى محتاجه يكون متوسط السعر 5 منازل عشرية يعنى مثلا يكون 1.53636 مثلا وهذا المطلب ينطبق على كل مكان فيه متوسط سعر وعمليات حسابية تعتمد على متوسط السعر يعنى حقل متوسط السعر وحقل زد فاليو وحقل توتال فاليو يبقو 5 ارقام عشرية .(مهمة جدا) 4-فى حالة صرف منتج يتم استدعاء متوسط السعر من جدول المنتجات ولا يضربه فى الكمية ولا ينتج زد فاليو . ده طبعا غير نقطة المنتج اللى تحته منتجات ,,, لو فى اى نقطة هتشكل مشكلة فى تطبيقها نحاول نشوفلها حل اخر مش عاوز اتعبك معايا اكتر من كده ربنا يتقبل منك صالح الاعمال ويحفظك

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

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

اتفضل استخدمت هذه الكود للاستخراج اي للبحث Private Sub SEr_Click() Me.s2 = DLookup("[name_e]", "Emp", "no_e= " & [s1]) Me.s3 = DLookup("[ms_j]", "Emp", "no_e= " & [s1]) Me.s4 = DLookup("[rs_t]", "Emp", "no_e= " & [s1]) Me.s5 = DLookup("[no_e]", "Emp", "no_e=" & [s1]) Me.Tarix = Nz(DMax(Format("[d_g]", "yyyy/mm/dd"), "egaza", "no_e=" & [s1] & "and [n_e]='" & "ÚÇÏíÉ" & "'"), "") Me.Mide = Nz(DLookup("[m_g]", "egaza", "[no_e]=" & [s1] & " And [Tarix]=" & Format("[d_g]", "yyyy/mm/dd")), 0) End Sub وهذا لخصم الرصيد من الاجازة Private Sub أمر30_Click() Dim SQL As String SQL = "UPDATE Emp SET Emp.rs_t = [Emp]![rs_t]-[Forms]![H]![Mide] WHERE (((Emp.no_e)=[Forms]![H]![s1]));" DoCmd.SetWarnings False DoCmd.RunSQL (SQL) DoCmd.SetWarnings True MsgBox "تم الخصم من الرصيد" End Sub اليك المرفق LM.rar

انا ما فكرت في الامر فلترة

شكرا للاستاذ شفان وهذا تعديل على الكود Dim rs As DAO.Recordset Dim i, r As Integer Set rs = Me.Subform.Form.RecordsetClone rs.MoveLast r = rs.RecordCount rs.MoveFirst For i = 1 To r CurrentDb.Execute "INSERT INTO InvSaveTable " & vbCrLf & _ "(InvoiceID,InvoiceDate,ItemID,ItemName,ItemPrice,Quantity)" & vbCrLf & _ "VALUES('" & InvoiceID & "','" & InvoiceDate & "','" & rs!ItemID & "'," & vbCrLf & _ "'" & rs!ItemName & "','" & rs!ItemPrice & "','" & rs!Quantity & "') " rs.MoveNext Next rs.Close Set rs = Nothing MsgBox "new recoreds are saved" وهذا المرفق مالتعديل على مفاتيح الجدول لمنع تكرار رقم الفاتورة مع رقم المنتج في تاريخ واحد ملاحظة يجب عدم ترك مسافات فارغة عند تسمية الكائنات ، ولاحظ اني غيرت اسم عنصر تحكم النموذج الفرعي db1.rar

أخي الكريم محمود المشكلة في هيكلة الملف .. غير مريحة للعمل عليها في الحقيقة عموماً جرب الكود التالي عله يفي بالغرض Sub Test() Dim rng As Range Dim cel As Range Application.ScreenUpdating = False With ActiveSheet .Rows("12:131").Hidden = False If Not IsEmpty(.Range("D4")) And Not IsEmpty(.Range("H4")) Then For Each cel In .Range("B12:B55") If cel.Value = "النسبة 1" Then If cel.Offset(1) = "" Or cel.Offset(1) = 0 Then If rng Is Nothing Then Set rng = cel.Resize(4) Else Set rng = Union(cel.Resize(4), rng) End If End If Next cel If Not rng Is Nothing Then rng.EntireRow.Hidden = True End If Else .Rows("12:55").Hidden = True End If If .Range("D55") = "" Or .Range("D55") = 0 Then .Rows("54:55").Hidden = True Set rng = Nothing: Set cel = Nothing '=============================================================== If Not IsEmpty(.Range("D5")) And Not IsEmpty(.Range("H5")) Then For Each cel In .Range("B56:B99") If cel.Value = "النسبة 2" Then If cel.Offset(1) = "" Or cel.Offset(1) = 0 Then If rng Is Nothing Then Set rng = cel.Resize(4) Else Set rng = Union(cel.Resize(4), rng) End If End If End If Next cel If Not rng Is Nothing Then rng.EntireRow.Hidden = True End If Else .Rows("56:99").Hidden = True End If If .Range("D99") = "" Or .Range("D99") = 0 Then .Rows("98:99").Hidden = True Set rng = Nothing: Set cel = Nothing '=============================================================== If Not IsEmpty(.Range("D6")) And Not IsEmpty(.Range("H6")) Then For Each cel In .Range("B100:B131") If cel.Value = "النسبة 3" Then If cel.Offset(1) = "" Or cel.Offset(1) = 0 Then If rng Is Nothing Then Set rng = cel.Resize(4) Else Set rng = Union(cel.Resize(4), rng) End If End If End If Next cel If Not rng Is Nothing Then rng.EntireRow.Hidden = True End If Else .Rows("100:131").Hidden = True End If If .Range("D104") = "" Or .Range("D104") = 0 Then .Rows("100:108").Hidden = True If .Range("D131") = "" Or .Range("D131") = 0 Then .Rows("129:131").Hidden = True Set rng = Nothing: Set cel = Nothing End With Application.ScreenUpdating = True End Sub

استأذن من استاذنا @محمدنجار استاذنا عبدالله قدوري حسب معلوماتي السبب يرجع لعملية في حقل الرصيد حضرتك استخدمت هذه المعادلة فقه =Nz(DSum("nz( [trdebit] )-nz( [trcredit] )";"kashf";"[id]<=" & [id]);0) احذف المعادلة سترى ان النتيجة هي كما تريد ولكي تحصل على المعادلة اعمل استعلام وفي استعلا اضف حقل جديد بهذه المعادلة واجعله مصدر النموذج الفرعي شوف انا عملت ما قلت في هذه المرفق وهذا هو الاستعلام SELECT kashf.*, Nz(DSum(Nz([trdebit],0)-Nz([trcredit],0),"kashf","[id]<=" & [id]),0) AS Rasid FROM kashf; Microsoft Access Database جديد.zip او استخدم =DSum("[TrCredit]";"kashf") و =DSum("[TrDebit]";"kashf") بدل =Nz(Sum([TrCredit])) و =Nz(Sum([Trdebit])) كمصدر لمرعات النصية في نموذج فرعي باسم تيكست 55 و تيكست 66 كما في المثال المرفق Microsoft Access Database جديد (1).zip اختر ماتريد

ولا يهمك اخى الفاضل سلمت يداك الفكرة شغالة كويس وطبقتها على الاستعلام الخاص بالتقرير الاخر واشتغلت الحمدلله للعلم انا سابقا جربت عندى نفس الكود بالظبط ولكنه لم يقبل الفاصلة المنقوطة ; وعندما استبدلتها بالفاصلة اعطى خطأ ولكنه الأن يقبل الفاصلة المنقوطة لماذا ؟! مع العلم انى استخدمه فى التقرير وليس Vba عامة تمام جزاك الله خير

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

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

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

:: اسف اعتذر منك اخي الخطا كان بسببي فقد حملت المرفق الخطأ .. تفضل ... :: وان تعذر عليك عمل التقرير الثاني فقط اعلمني بذلك ... بالتوفيق . Test_up.rar

وعليكم السلام ورحمة الله يمكنك أيضا استخدام الوظيفة التالية في استعلام Function GetNumbers(SText) For i = 1 To Len(SText) If Not (IsNumeric(Left(SText, i))) Then GetNumbers = Left(SText, i - 1) Exit Function End If Next End Function New Microsoft Access Database.zip

عليكم السلام ورحمة الله وبركاته كل شئ ينفع يا أخى بس ارفق القاعدة المطلوب التعديل عليها

:: عليكم السلام استاذ عبد الله تفضل كان الخطا هو الحمع في النموذج الفرعي DB_UP.rar

شرح جميل بارك الله فيك أستاذنا.

للرفع للاستفاده من العمل الرائع

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