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

Replace the number with the cell value. What's difficult at this point replace the number 1 with range("A1").value for example

اخوانى اريد المساعدة فى هذا البرنامج حيث عند اختيار نوع تحليل CBC ووضع نتيجة التحليل اريد إظهار جدول Differential leucocyte Count لكى أقوم بعمل حسابات مثل المثال فى ملف الورد والاكسيل المرفق وبعد ذلك اظهار هذه القيم فى التقرير الخاص بهذا النوع عند الطابعة . Desktop.rar

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

جزيل الشكر لك اخي العزيز

رمضان مبارك اخي @ابو جودي بصراحة عجبني الكود كثيرا وهو يقفز على جميع السجلات .. لكن لا اتخيل مدى فعاليته عندما يكون لدينا ملايين السجلات ؟

السلام عليكم ورحمة الله وبركاته يمكنك استخدام المعادلة التالية واسحب نزولاً =SUM((B2*30);A2) تقبل تحياتي العطرة

Sub Test() Dim a, x, e, v, wsData As Worksheet, wsExisting As Worksheet, wsA As Worksheet, wsF As Worksheet, wsM As Worksheet, sh As Worksheet, i As Long, ii As Long, k1 As Long, k2 As Long, k3 As Long, n As Long Application.ScreenUpdating = False Set wsData = ThisWorkbook.Worksheets("Data") Set wsExisting = ThisWorkbook.Worksheets("Feuil1") Set wsA = ThisWorkbook.Worksheets("ARABE") Set wsF = ThisWorkbook.Worksheets("FRANCAIS") Set wsM = ThisWorkbook.Worksheets("MIXTE") a = wsData.Range("A2:H" & wsData.Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim b1(1 To UBound(a, 1), 1 To UBound(a, 2) - 1) ReDim b2(1 To UBound(a, 1), 1 To UBound(a, 2) - 1) ReDim b3(1 To UBound(a, 1), 1 To UBound(a, 2) - 1) For i = LBound(a, 1) To UBound(a, 1) x = Application.Match(a(i, 1), wsExisting.Columns(1), 0) If Not IsError(x) Then GoTo NXT If a(i, 8) = "ARABE" Then k1 = k1 + 1 For ii = 1 To 7 b1(k1, ii) = a(i, ii) Next ii ElseIf a(i, 8) = "FRANCAIS" Then k2 = k2 + 1 For ii = 1 To 7 b2(k2, ii) = a(i, ii) Next ii ElseIf a(i, 8) = "MIXTE" Then k3 = k3 + 1 For ii = 1 To 7 b3(k3, ii) = a(i, ii) Next ii End If NXT: Next i For Each e In Array(1, 2, 3) If e = 1 Then Set sh = wsA: n = k1: v = b1 ElseIf e = 2 Then Set sh = wsF: n = k2: v = b2 ElseIf e = 3 Then Set sh = wsM: n = k3: v = b3 End If If n > 0 Then sh.Range("A1").CurrentRegion.ClearContents sh.Range("A1").Resize(, 7).Value = wsData.Range("A1").Resize(, 7).Value sh.Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v End If Next e Application.ScreenUpdating = True End Sub

تفضل هذا التعديل test.zip

اختي الكريمة قد تكون المشكلة من المتصفح الذي تستخدمينه يجب تعيينه كافتراضي هذه محاولة من قائمة ابدا < تشغيل < Set program access and computer defaults وقومي بتعيين المتصفح الذي تعملين عليه كافتراصي تحياتي

تفضل استخدم هذا الكود في آخر محرر الأكواد الصق الكود التالي Public Function SetProdact(Barcod As String, SetCoulmin As String) Dim db As DAO.Database, rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset(" SELECT * FROM [المخزن] where [رقم_الباركود] Like '*" & Barcod & "*'") SetProdact = rs.Fields(SetCoulmin) rs.Close Set rs = Nothing End Function و في مربع اسم الصنف الصق التالي =SetProdact(Text420, "الصنف") 2.zip

جرب الكود =nz(DSum("[Balance]";"[t_Query]";"[تاريخ الحركة]<" & [forms]![date01]![a]);0)

جزاكم الله خيرا ---------------- طيب للايضاح أكثر ممكن حضرتك تقول لى بالنسبة للعميل رقم 9 مجموع الحقول الاشهر التي سددها العميل المفروض تساوى كام ؟ رقم اخر وصل المفروض = ايه من واقع البيانات فى المرفق

صيام مقبول ان شاء الله وافطار شهي شكرا لك جزاك الله كل خير

I am so sorry as I don't attach any files at all Wait for someone who can do that for you GenerateUniqueRandom ActiveSheet, "D3:F22", Range("A1").Value, Range("A2").Value

اخى الكريم هذه هى المعادلة بالفعل الصحيحة فغير منطقى ان يصل بها الشهور الى 12 شهر لأنه سيتحول تلقائى الى السنة ونفس الحال بالنسبى لعدد الأيام فلا يصل أبداً الى 30 يوم لأنه سيتحول تلقائياً الى الشهر ... وشكراًُ =(YEAR(C3)-YEAR(B3))+(MONTH(C3)-MONTH(B3))/12+(DAY(C3)-DAY(B3))/365 تحليل1.xlsx

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

اتفضل انا عملت لك الكود بالشكل ده حتى يكون مرن فيمكن استخدامة لاى قاعدة ومع اى جدول Function MyID(ByRef strFieldName As String, ByRef strTableName As String) Dim lngNextNumber As Long Dim strNextNumber As String Dim strNewID As String Const intNumberOfZeros = 6 lngNextNumber = Nz(Right(DLast("[" & strFieldName & "]", strTableName), intNumberOfZeros), 0) + 1 strNextNumber = String(intNumberOfZeros - Len(CStr(lngNextNumber)), "0") & CStr(lngNextNumber) strNewID = "EN" & Format(Date, "yy") & Format(Date, "mm") & Format(Date, "dd") & strNextNumber MyID = strNewID End Function طبعا ممكن وضع الوظيفة السابقة فى موديول ويتم استدعاؤه حسب الحاجة تبعا لاسم الجدول واسم حقل الترقيم المخصص داخل الجدول من خلال السطر الاتى TextBox= MyID("movement_N", "movement") ملاحظة ممكن تتحكم فى عدد الاصفار من خلال تغيير الرقم 6 فى السطر تبعا للعد اللى تبغاه انت Const intNumberOfZeros = 6 الحركة (3).accdb

عدلت الكود ولكن لاحظت أنه لايتم زيادة الرقم تصاعدي وانه يتكرر نفس الرقم في كل مرة يعني المفروض اول سجل بيكون كالتالي EN220408001 فالسجل الثاني يكون رقمه EN220408002 وهكذا تصاعدي الحركة.accdb

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

اخي اولا اللغه العربية غير ظاهرة فى محرر الكواد امامك حلين 1 - تغير اسماء الشتات الي اللعة الانجليزية وتغير ايماءها فى الكود 2 - ضبط اعدادت محرر الاكواد كالاتي فى محرر الاكود اختار Tools ثم اختار Editor Format ثم غير الفونت الي Courier New (Arabic) in VB Editor: 1- click Tools 2- select Options... 3- click Editor Format 4- change font to Courier New (Arabic) 5- click OK اخي لست في حاجه لضغط الزر عشر مرات امكتب مائة صنف واضغط الزر مره واحده اذا لم يناسبك هذا ارجع الي النسخة السابقة له او التي فبلها كلهم جيد

شاهد المرفق اخي سها.xlsm

السلام عليكم ورحمة الله اضرب الرقم فى 100 و اقسم الناتج على 84 تعرف اصل الرقم قبل الخصم

اخي لم تعمل جدول الشرائح راجع الشرائح فى كود موديول 2 ( Module2 ) اولا : ستقوم بحذف الاعمدة المخفية لم يعد لها حاجه فالشرائح في شيت مستقل يمكنك اخفاءه ثانيا : كل ما عليك هو ادخال رقم كود الصنف والكمية واضغط الزر الاخضر سواء لصنف واحد ام عدة اصناف نحياتي برنامج محاسبه.xlsm

اعكس الاشارات كما في مثالي السابق

ارى لديك سجلات موظفين ماترغب تحفظ الصورة لكل موظف على حده؟ باسمه او برقم المعرف ،، او مجلد منفصل لكل موظف

لا تحتاج الى عمل وحدة نمطية اكثر من مرة ولا تحتاج الى تكرار الاكواد بدون داعى فقط لابد من إزالة Exit Function وموقعها في الكود بين الروتين الذى يتم تطبيقه على النماذج والروتين الذى يتم تطبيقه على التقارير ولم يتم تغيير الخط فقط في التقارير بسبب الخروج من الروتين بسبب هذا السطر والأفضل من استخدام On Error Resume Next استخدام كود تصيد الأخطاء ErrorHandler لتتمكن من الوقوف على سبب ومكان وتوصيف ورقم الخطأ وتمت التعديلات كالاتي إزالة Exit Function تغيير اسم الروتين العام حتى يتناسب مع الوظيفة التي يقوم بها ليسهل مستقبلا لأى مطور التعامل بسهولة في قاعدة البيانات إضافة كود تصيد الأخطاء ErrorHandler للوقوف على سبب ومكان وتوصيف ورقم الأخطاء حتى يسهل تفاديها إن وجدت أخطاء إضاقة متغير ثابت في أول الكود ليتم وضع اسم الخط فقط مرة واحدة في الروتين من باب المرونة والتسهيل على المطور ملاحظة هامة جدا جدا لابد من تغير اسم الخط الذى قمت انا باستخدامه في الوحدة النمطية وهو Calibri (Detail) باسم الخط الذى تريد أنت التغيير إليه وقمت بوضع هذا التلميح للتذكير في الوحدة النمطية عند المتغير الثابت الذى يحمل اسم الخط <<---------< Font name must be changed here between the quotation marks يتم استدعاء الكود من خلالChange Font.mdb Call ApplyDefaultFont وأخيرا الروتين والذى يتم وضعه داخل وحدة نمطية Function ApplyDefaultFont() On Error GoTo ErrorHandler Const strFontName = "Calibri (Detail)" ' <<---------< Font name must be changed here between the quotation marks Dim frm As AccessObject Dim rpt As AccessObject Dim dbs As Object Dim frm1 As Access.Form Dim rpt1 As Access.Report Dim ctl As Access.Control Set dbs = Application.CurrentProject ' Apply Default Font for All Forms For Each frm In dbs.AllForms DoCmd.OpenForm frm.Name, acDesign Set frm1 = Forms(frm.Name) For Each ctl In frm1.Controls If ctl.ControlType = acComboBox Or _ ctl.ControlType = acCommandButton Or _ ctl.ControlType = acLabel Or _ ctl.ControlType = acListBox Or _ ctl.ControlType = acOptionButton Or _ ctl.ControlType = acTextBox Then ctl.FontName = strFontName 'Debug.Print frm.Name & " > " & ctl.ControlType & " > " & ctl.Name If frm1.DefaultView = 2 Then frm1.DatasheetFontName = strFontName End If End If Next ctl DoCmd.Close acForm, frm.Name, acSaveYes Next frm ' Apply Default Font for All Reports For Each rpt In dbs.AllReports DoCmd.OpenReport rpt.Name, acDesign Set rpt1 = Reports(rpt.Name) For Each ctl In rpt1.Controls If ctl.ControlType = acComboBox Or _ ctl.ControlType = acCommandButton Or _ ctl.ControlType = acLabel Or _ ctl.ControlType = acListBox Or _ ctl.ControlType = acOptionButton Or _ ctl.ControlType = acTextBox Then ctl.FontName = strFontName 'Debug.Print rpt.Name & " > " & ctl.ControlType & " > " & ctl.Name If rpt1.DefaultView = 2 Then frm1.DatasheetFontName = strFontName End If End If Next ctl DoCmd.Close acReport, rpt.Name, acSaveYes Next rpt Set frm = Nothing Set rpt = Nothing Set dbs = Nothing Set frm1 = Nothing Set rpt1 = Nothing Set ctl = Nothing Exit Function ExitHandler: Exit Function ErrorHandler: MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description End Function وهذا مرفق التطبيق لتعم الفائدة ويكون مرجعا سهلا ان شاء الله Change Font.mdb

تفضل هذا المثال اكمالي البيانات و جربي الاتصال بجدول MyData.zip

بكل بساطة اعكس العملية Dim LastRow As Long LastRow = ThisWorkbook.Sheets("xx").Range("g1").End(xlDown).Row LastRow = LastRow + 1

بسم الله الرحمان الرحيم السلام عليكم اصدقائي قررت في الفترة الاخيرة اعتزال البرمجة بالاكسل و vba ولا اظن اني ساعود له بما اني كنت اعمل على بعض المشاريع بواسطة الاكسل و لاكن للاسف لم اجد الوقت الكافي لانهائها قررت ايضا طرح تلك المشاريع لربما لتستفيدون منها لذاى ساقوم في كل مرة يتاح لي الوقت فيها برفع مشروع او اثنين ان شاء الله كاول مشروع هذا برنامج مبيعات /كودبار/يعتمد ايضا القطعة و العلبة تقريبا انجز 80% منه لم يتبقى له سوى التقارير و بعض الاشياء الاخرى تحياتي للجميع Pr Commercial.rar

مشاركة مع اساتذتي واحبتي استاذ فايز.. واستاذ الفلاحجى واستاذ محمد أبوعبدالله الارصدة-10.rar

بالاضافة الى ما تفضل به استاذنا الفاضل @الفلاحجى وله جزيل الشكر يمكن استخدام الكود التالي كمصدر لحقل الرصيد =Nz(DLast("nz(باقى)";"ti";"[Id]<" & [Id]);0) تحياتي

السلام عليكم نموذج فواتير منوع (مبيعات /مشتروات/ مردوات المبيعات/مردودات المشتروات) بامكانية: الترحيل والبحث والتعديل وحذف الكل طلب للاخ تامر جمال جعلته هنا لفائدة الجمع الكريم ______________.rar

السلام عليكم ورحمه الله يرجى الاطلاع على المرفق معمل اللؤلؤه.rar

السلام عليكم ورحمة الله وبركاته اشكركم يا شباب على حسن ترحيبكم اشكرك اخي ابو الآء 1. التقرير عبارة عن تقرير عادي ، يمكنك عمل ما شئت به من طباعة وحفظ بالصيغ التي يسمح بها الاكسس 2. فكرة ممتازة ، لانه في بعض الاشياء اللي لها علاقة بالكود ، وقد يستفيد منها الآخرون ، فمثلا: الكود يعمل قاعدة بيانات خارجية ، ويلصق بها البيانات التي طلبتها ، ثم يمسح هذه القاعدة ، والسبب اني عملت هذا ، لأني لا احبذ ان تكون الجداول المؤقته في البرنامج ، حيث ادخال البيانات فيها ثم حذفها ، يؤثر على حجم البرنامج ، ويجب عليك عمل Com[act and Repair بين الحين والآخر ، بينما عمل جدول مؤقت في قاعدة بيانات مؤقته خارج البرنامج ، لا يكلف إلا كود في عملها ، وكود آخر في حذفها ، وَكَفَى اللَّهُ الْمُؤْمِنِينَ الْقِتَالَ جعفر

بارك الله فيك اخى الكريم على جهودك وبالتوفيق

كما تشاء

خلاص يا اخي حوضحلك الجداول : 1- جدول DialyData لتسجيل النتائج وهو مربوط مع ( TestGenData - Patients ) وهو مصدر السجلات للنموذج الفرعى فى النموذج TestGenData و TestGenData1 2- جدول Expenses المصروفات ( 1- كود المصروف 2- التاريخ 3- البيان 4- المبلغ ) . 3- جدول Income الدخل او الايراد الخاص بقيم التحاليل ( 1- رقم الايراد او الايصال 2- كود المريض 3- قيمة التحليل 4- الخصم 5- المبلغ بعد الخصم 6- المدفوع 7- الباقى 8- الاجمالي ). 4- جدول Patients المرضى الحقول بالترتيب (1- كود المريض 2- اسم المريض 3- النوع 4- العمر 5- تحديد الفترة الزمنية للعمر سواء باليوم او الشهور او السنوات 6- التليفون 7- الاميل ). 5- جدول phyisicans الاطباء ( 1- اسم الطبيب 2- اللقب 3- التخصص 4- العنوان 5- التليفون 6- الاميل ) . 6- جدول subDlCount هذا الجدول لاستخراج حسابات خاص بالكرات البيضاء بعد استخراج نتائج نوع التحليل CBC الحقول ( 1- Differential leucocyte Count تفاصيل الكرات البيضاء 2- Relative المعدل او النسبة بالمائة 3- المعدل الطبيعي 4- العدد المطلق وفى هذا الحقل يتم ضرب حقل Relative المعدل او النسبة بالمائة فى حقل النتيجة Result حقل 5- المعدل الطبيعي بعد عملية الضرب 6- نوع التحليل ) . 7- جدول TestDetails الحقول ( 1- رقم خاص بالنوع الفرعى ولا يتكرر 2- المجموعة التى ينتمى اليها النوع التحليل الفرعي 3- نوع التحليل الرئيسي 4- وحدة القياس 5- المعدل الطبيعي 6- تفاصيل او اسم التحليل الفرعي ) وهذا الجدول مربوط مع جدول TestTypes وهما خاصين بتسجيل الانواع الرئيسية والفرعية بكل تحليل كقاعدة بيانات . 8- جدول TestGenData هذا الجدول خاص ببيانات التحليل وهو مربوط مع جدول المريض وجدول DialyData الاول والحقول ( 1- رقم لا يتكرر خاص بنوع التحليل 2- نوع التحليل الرئيسي 3- كود المريض 4- تاريخ استلام العينة 5- التحليل انتهى ام لا 6- اسم الطبيب 7- عنوان التعليق 8- نص التعليق ) . 9- جدول TestTypes وهو خاص بانواع التحليل الرئيسية وهو مربوط مع جدول رقم 7 TestDetails وجدول رقم 4 Patients الحقول ( 1- نوع التحليل او النوع العام 2- وصف للتحليل ) . 10- جدول TmpData تفاصيل نتيجة التحليل الحقول ( 1- رقم لا يتكرر 2- كود المريض 3- تفاصيل التحليل 4- نتيجة التحليل 5- وحدة القياس 6- المعدل الطبيعي ) وهذا الجدول مربوط مع جدول TmpPat . 11- جدول TmpPat البيانات الخاص بالمريض والدكتور والتحليل بصفة عامة الحقول ( 1- كود المريض 2- اسم الطبيب 3- اسم المريض 4- عنوان المريض 5- النوع 6- العمر 7- نوع الفترة الزمنية 8- التليفون 9- الاميل 10- نوع التحليل 11- تاريخ التحليل 12- عنوان التعليق 13- نص التعليق ) . ملحوظة : الجداول ( 10 - 11 ) منفصلين عن باقى الجداول الا نوع التحليل وتفاصيل التحليل وهما خاصين بتسجيل المريض العشوائي فقط .وهما خاصين بالنموذج TmpPat ، TmpDataٍSub الرجاء ان يكون جميع الجداول وضحت وان شاء الله منتظر المساعدة فى الاستفسار السابق الخاص بحساب قيم خاص بالكرات الدم البيضاء الخاص بالتحليل CBC مثل ما هو مرفق فى ملف الاكسيل . ومن يريد الاضافة او التعديل على هذه الجداول او الاستعلامات المهم ان نخرج ان شاء الله برنامج تحليل جيد جداً .

من تتبع الجداول لا أرى علاقات واضحة بين الجدول subDlCount و اية جداول أخرى ثم ان هناك تعداد و تشعب كبيرين بين جداول التحاليل , لديك أربعة جداول للتحليل testgendata test details daily data subdlcount هذا ماعدا الجداول المؤقتة أوضح ما يلي - ماهي مهمة كل جدول - ماهي مهمة كل حقل في كل جدول - ماهي العلاقة بين كل تلك الجداول

اشكرك يا اخى على ردك ومرورك ولكن ليس هذا المطلوب فعملك هذا على راسى ولكن سوف ابدأ من جديد الملف المرفق الاكسس هو برنامج انتهى تقريبا وبدأ الخروج الى النور ولكن يلزمه شوية تظبيطات من اهل الخبرة حتى لا يكون فيه ثغرات ولو دخلت عليه تلاقي معظم التحاليل مسجلة ولكن الحساب فقط لهذا النوع ويكون الحساب لقيم التحليل بالمعادلات مثل الملف الاكسيل المرفق فالمطلوب هو ربط الجدول Differential leucocyte Count مع هذا النوع من التحليل CBC حتى عند اختياره يتم عمل هذه الحسابات فى الجدول Differential leucocyte Count واظهاره عند طباعة النتيجة فى تقرير مثل الملف الاكسيل واشكركم جميعا

السلام عليكم ورحمة الله وبركاته ,,, عملت قاعدة جديدة وقمت بالاعمال التالية: قمت بعمل نموذج " 222" كنموذج رئيسي ونموذج اخر لإدخال الأنواع الرئيسية فقط بيحث يمكنك الاختيار منها لاحقا واضافة التفاصيل ,,, ارجوا التوضيح اكثر بخصوص القيم التي تود اظهارها واين تود حفظها وهل هي خاصة فقط بتحليل الــ cbc ام لكافة التحاليل عموما اتمنى ان يفيدك المرفق ولو بالقليل ,, وفقنا الله واياك ,, laboratory.rar

السبب هو تكرار الجدول في استعلام البحث search 3.rar