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

وعليكم السلام ورحمة الله وبركاته من هنا البدايه https://www.officena.net/ib/topic/37509-ساعه-رقمي-وتناظري

وعليكم السلام-تفضل على الرغم انك لم تقم برفع ملف توضيحى لطلبك =LEN(A1)

تكتب هكذا أخي أبو أحمد : 🙂 Format([MyTimeTxtbox], "hh:nn") حرف الـ m محجوز للشهر حتى هذه يمكن كتابتها هكذا : Hour([MyTimeTxtbox]) & ":" & Minute([MyTimeTxtbox])

افتح النموذج ثم اضغط على الزر الموجود ........ Bar_234.accdb

طيب ... بالنسبة لهذا الحقل تريد ان تكون حسب السجل الاول ام الثاني

هل هذا التصور صحيح .... انظر الصورة ودقق هل النتيجة الظاهرة صحيحة كما تريد ؟؟؟؟

بعد ادن استادنا الكبير ابراهيم الحداد واثراءا للموضوع يمكنك استخدام الكود التالي Sub SUM_MH() Dim LastRow As Long, i As Long, officena As Long, MH As Long Application.DisplayAlerts = False officena = 1 With ThisWorkbook.Worksheets("بيانات") LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1 For i = 1 To LastRow If .Range("b" & i).Value = "اجمالي العملاء" Or .Range("b" & i).Value = "اجمالي الموردين" Then MH = i - 1 .Range("C" & i).Value = Application.Sum(.Range(.Cells(officena, 3), .Cells(MH, 3))) .Range("D" & i).Value = Application.Sum(.Range(.Cells(officena, 4), .Cells(MH, 4))) .Range("E" & i).Value = Application.Sum(.Range(.Cells(officena, 5), .Cells(MH, 5))) officena = i + 1 Application.DisplayAlerts = True End If Next i End With End Sub . wor1.xlsm

الحمد لله الذي بنعمته تتم الصالحات مبارك عودتك اخى الكريم

السلام عليكم و رحمة الله استخدم هذا الكود Sub SumThig() Const str1 As String = "اجمالي العملاء", str2 As String = "اجمالي الموردين" Dim LR As Long, i As Long, x As Integer, y As Integer With Sheets("بيانات") LR = .Range("B" & Rows.Count).End(3).Row For i = 3 To LR If .Range("B" & i) = str1 Then x = i ElseIf .Range("B" & i) = str2 Then y = i End If Next .Range("E" & x) = WorksheetFunction.Sum(.Range("E3:E" & x - 1)) .Range("E" & y) = WorksheetFunction.Sum(.Range("E" & x + 1 & ":E" & y - 1)) End With End Sub

شكرا جزيلا

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

السلام عليكم أخي الكريم هذا كود تفقيط جزى الله خيراً من عمله ووضعه بين أيدي الناس ليعملوا به يمكنك تعديله ليناسب عملك Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String If TheNo > 999999999999.99 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "يتبقى لكم " Else ReMark = "فقط " End If If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "أربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "أربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "واحد" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "أربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(Myno, 1, 3)) > 0 Then RdNo = Mid$(Myno, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(Myno, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(Myno, 2, 1) My10 = MyArry2(RdNo) If Mid$(Myno, 2, 2) = 11 Then My11 = "إحدى عشر" If Mid$(Myno, 2, 2) = 12 Then My12 = "إثنى عشر" If Mid$(Myno, 2, 2) = 10 Then My10 = "عشرة" If ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur + " " + "لا غير" Else NoToTxt = ReMark + MyFraction + " " + MySubCur + " " + "لا غير" End If Else NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + " " + "لا غير" End If End Function

تفضل

دوال التكرار كثيرة ... انظر وطبق الأول: الدالة For Dim i As Integer, k As Integer k = 4 For i = k To 1 Step -1 MsgBox i Next i الثاني: الدالة Do While Dim i As Integer i = 4 Do While i >= 1 MsgBox i i = i - 1 Loop الثالث: الدالة Do Until Dim i As Integer i = 4 Do Until i < 1 MsgBox i i = i - 1 Loop الرابع: الدالة Do.....Loop Until Dim i As Integer i = 4 Do MsgBox i i = i - 1 Loop Until i < 1 الخامس: الدالة Do.....Loop While Dim i As Integer i = 4 Do MsgBox i i = i - 1 Loop While i >= 1

والان بعد الشروحات والمقدمات الطويلة للفائدة هذه الطريقة الاخيرة مختصرة وبدون استعلامات .... نفس طريقتك السابقة مع تعديل بسيط فقط Value Students (1).accdb

وايضا يمكن عملها في الاستعلام مباشرة بهذا الشكل ...........

تفضل <><><><><> Students.accdb

اخي @الشربيني 123 من يستحق افضل اجابة هي اجابة استاذي الفاضل @jjafferr بارك الله بك وبه .....

تفضل <><><><><> On Error Resume Next DoCmd.OpenReport "R1", acViewReport, , "[المؤهل]=" & Me.HA & " and [النوع]=" & Me.SI DoCmd.Close acForm, Me.Name

ارفق مثال للنموذج والتقربر

هل النموذج المراد اغلاقة به هذا الزر الذي يحوي الكود السابق ؟؟؟؟؟

جرب ................ DoCmd.Close DoCmd.OpenReport "M11", acViewReport, , "[GER]=" & Me.GE & _ "and [NOV]=" & Me.SX

تحية طيبة ..طبقت لك ما أردت حسب جداولك المرفقة ..أرجو أن تكون مفيدة ملف العملاء.xlsx

تفضل اخي Sub SUM_MH() Dim LastRow As Long, i As Long, officena As Long, MH As Long Application.DisplayAlerts = False Last = Cells(Rows.Count, "b").End(xlUp).Row For i = Last To 2 Step -1 If (Cells(i, "b").Value) = "الاجمالي العام" Then Range(Cells(i, "c"), Cells(Rows.Count, 5)).ClearContents End If Next i officena = 1 With ThisWorkbook.Worksheets("البيانات") LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For i = 1 To LastRow If .Range("b" & i).Value = "اجمالي الموردين" Or .Range("b" & i).Value = "اجمالي العملاء" Then MH = i - 1 .Range("C" & i).Value = Application.Sum(.Range(.Cells(officena, 3), .Cells(MH, 3))) .Range("D" & i).Value = Application.Sum(.Range(.Cells(officena, 4), .Cells(MH, 4))) .Range("E" & i).Value = Application.Sum(.Range(.Cells(officena, 5), .Cells(MH, 5))) .Range("C" & LastRow) = .Range("C" & LastRow) + .Range("C" & i) .Range("D" & LastRow) = .Range("D" & LastRow) + .Range("D" & i) .Range("E" & LastRow) = .Range("E" & LastRow) + .Range("E" & i) officena = i + 1 Application.DisplayAlerts = True End If Next i End With End Sub wor1-3.xlsm

استخدم دالة التنسيق Format: Format([MyTimeTxtbox], "hh:mm") 'غير متأكد الآن استخدام mm للدقائق 'ربما تكون nn

أرجو اختبار هذا الملف المرفق لم أعمل على الجدول الملون بالأخضر ، لأن عمليات الحساب فيه غير دقيقة للأسف. ملف العملاء.xlsx

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

ممكن عن طريق التنسيق الشرطي .. 🙂

تم العمل بنجاح شكرا لاستاذي مبرمج متعاقد والاستاءmoosk هذا مااردته بضبط بعد تجارب متعدد لاني نسيت بعض الامور بسبب تقدم السن فشكرا لكم جميعا للمحاولاتكم معي وهذا المثال بعد جاهزيته جاهز.rar

الشكر لله استاذ احمد من اسهل الطرق لانشاء المجلد عمل ملف يعدل على الرجيستري وهذا مفيد عند تعدد المستخدمين بدلا من ان تقوم بالتعديل اليدوي لكل جهاز [HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations\Location1] "Path"="\\\\DESKTOP-AOJOU45\\test2\\" "AllowSubfolders"=dword:00000001 "Description"="" هذا المسار خاص بمجلد الشبكة الخاص بي واذا اردت استخدامة ضع مسار الشبكة الخاصة بك السطر الثالث يعني ان المجلدات الفرعية امنه ايضا وفي حالة عدم الرغبة فقط احذف السطر ------------------------------------------------- دائما لا انصح بالتعديل على سجل النظام الا اذا كنت على معرفة بما تعمل قبل اي تعديل انصح بحفظ نسخة احتياطية من سجل النظام جعل مجلد الشبكة امن فيه مخاطرة وحتى شركة مايكروسوفت لا تنصح بذلك تحياتي

مشاركة مع استاذنا @احمد الفلاحجي طريقة اخرى باستخدام عبارة not in لتكون جملة الاستعلام ⬇️ وهنا لسنا بحاجة الى عمل علاقة بين الجدولين في الاستعلام SELECT [2].[رقم العائلة] FROM 2 WHERE ((([2].[رقم العائلة]) Not In (SELECT [1].رقم FROM 1;))); الملف مرفق استعلام q_2 والعكس لو اردنا ان نحصل على السجلات المشتركة بين الجدول فقط نحذف عبارة not لتكون جملة الاستعلام ⬇️ SELECT [2].[رقم العائلة] FROM 2 WHERE ((([2].[رقم العائلة]) In (SELECT [1].رقم FROM 1;))); ملاحظة استخدام ارقام لاسماء الجداول ليست صحيحة تحياتي مثال_1.accdb

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

السلام عليكم 🙂 الشباب قلبوا الكود ، فبعد اغلاق النموذج ، لا يمكنك قراءة قيمة من النموذج 🙂 المفروض يكون: Private Sub GO152_Click() On Error Resume Next DoCmd.OpenReport "M11", acViewReport, , "[GER]=" & Me.GE & " and [NOV]=" & Me.SX DoCmd.Close acForm, Me.Name End Sub او Private Sub GO152_Click() On Error Resume Next dim GE2 as long,SX2 as long GE2=me.GE : SX2= me.SX DoCmd.Close acForm, Me.Name DoCmd.OpenReport "M11", acViewReport, , "[GER]=" & GE2 & " and [NOV]=" & SX2 End Sub جعفر

جرب اذا ناسبقك ..... تأكد من الاعمار لديك واكمل حتى تتعلم الكود ...... Aziz (2).zip

منطقيا وحسب ماذكرت انت ...... هذه الحسبة تختلف من سنة لاخرى فمثلا : 2017 = تمهيدي هذه السنة 2017 = الاول السنة القادمة وهكذا لبقية التواريخ ..... لذلك ارى والله أعلم ان تفكر في عمر التلميذ وليس السنة ........

نعم أخي قاسم يمكننا قراءة الجملة هكذا : أضف إلى Insert Into الجدول التالي ... Tbl_DBContent تحديداً الحقلين التاليين .. (Type, sName) والقيم المراد إضافتها بالتتالي values القيم هي : objectName , rs!Name حيث أن objectName هو اسم متغير أخزن فيه نوع العنصر و rs!Name هو اسم العنصر حسب مصدر السجلات --------------------------------------------------------------- و التنسيق الصحيح الذي نضع عليه المتغيرات في الكود هكذا : ;values ( ' " & objectName & " ',' " & rs!Name & " ' ) وضعنا علامة التنصيص المفردة حوالي المتغيرات ( ' ) لأنهما من نوع نص .. ولو كانا من نوع تاريخ نستبدلهما بــ ( # ) .. أما لو كانا من نوع رقم فنحذفهما ولا يوضع شي مكانهما .. تم وضع المتغير بين علامتي التنصيص (" ") والرمز & لأن المتغير (من اسمه فإن قيمته تتغير غير ثابته ) لذلك نخرجه من الجملة ذات القيمة الثابتة بهذه الطريقة: " & objectName & " هذا درس على السريع .. بالتوفيق 🙂

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

السلام عليكم تفضل يجب عليك تغير امتداد الملف ليصبح هكذا xlsm. الملف test.xlsm

You can change the date in the code Sub Test() Const sReport As String = "Report" Dim ws As Worksheet, myDate As Date, lr As Long, r As Long, c As Long, k As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) lr = ws.Cells(Rows.Count, "C").End(xlUp).Row myDate = CLng(DateSerial(2017, 1, 1)) ReDim a(1 To (lr - 2) * 7, 1 To 6) For r = 3 To lr For c = 9 To 27 Step 3 If ws.Cells(r, c + 1).Value2 >= myDate Then k = k + 1 a(k, 1) = ws.Cells(r, 3).Value a(k, 2) = ws.Cells(r, 6).Value a(k, 3) = ws.Cells(r, 7).Value a(k, 4) = ws.Cells(r, c).Value a(k, 5) = ws.Cells(r, c + 1).Value a(k, 6) = ws.Cells(r, c + 2).Value End If Next c Next r If k > 0 Then On Error Resume Next Application.DisplayAlerts = False Worksheets(sReport).Delete Application.DisplayAlerts = True On Error GoTo 0 Sheets.Add(After:=Sheets(Sheets.Count)).Name = sReport With Worksheets(sReport) .DisplayRightToLeft = True .Range("A1").Resize(, 6).Value = Array("Father Name", "Mother Name", "Place", "Child", "Birth Date", "ID") .Range("A2").Resize(UBound(a, 1), UBound(a, 2)).Value = a .Columns.AutoFit End With End If Application.ScreenUpdating = True MsgBox "Done...", 64, "LionHeart" End Sub

ابشروا تبقى قليل للدورة لعمل تطبيق مربوط بالاكسس وعرض التقارير والمعلومات الاساسية به .