نجوم المشاركات
Popular Content
Showing content with the highest reputation on 09 أكت, 2021 in all areas
-
5 points
-
طيب <<<<<<>>>>>>> هل المدة المعلمة باللون الازرق هي مدة الاقتطاع أم ماذا تمثل في الجدول ؟؟؟؟3 points
-
3 points
-
الكود ليس فيه جديد ( هو استعلام ولكن عن طريق VB فقط ) لو قمت بنسخ هذا الجزء مثلا والصقتة في طريق عرض SQL في الاستعلام يظهر لك الاستعلام INSERT INTO 1 ( [رقم الكتاب], [تاريخ الكتاب], الاسم, الوظيفة, الموضوع, [اسم المستلم], [تاريخ الاستلام], المرحلة ) SELECT المعاملات.[رقم الكتاب], المعاملات.[تاريخ الكتاب], المعاملات.الاسم, المعاملات.الوظيفة, المعاملات.الموضوع, المعاملات.[اسم المستلم], المعاملات.[تاريخ الاستلام], المعاملات.المرحلة FROM المعاملات WHERE (((المعاملات.[رقم الكتاب])=[Forms]![ادخال بيانات]![رقم الكتاب])); ثم في حدث الزر استدعيه بهذه الصورة فلن تعمل رسائل التحذير .... طبعا هذه طريقة وهناك طرق اخرى .. DoCmd.SetWarnings False DoCmd.OpenQuery "استعلام1" DoCmd.SetWarnings True3 points
-
لاضافة جدول في قاعدة خارجية استخدم الاتي <<<<<<<>>>>>>>> Dim msgstyle Dim strSQL1 As String Dim b As New Access.Application Set b = CreateObject("Access.Application") b.OpenCurrentDatabase (Me.txtPath) strSQL1 = "CREATE TABLE [kanory] ([ProductID] AUTOINCREMENT,[ProductName] TEXT(40) NOT NULL,[SupplierID] LONG,[BirthDate] DATETIME,[CategoryID] LONG,[QuantityPerUnit] TEXT(20),[UnitPrice] CURRENCY,[UnitsInStock] SMALLINT,[UnitsOnOrder] SMALLINT,[ReorderLevel] SMALLINT,[Discontinued] BIT NOT NULL,CONSTRAINT [PrimaryKey] PRIMARY KEY ([ProductID]));" b.DoCmd.RunSQL strSQL1 MsgBox Space(20) & "تم انشاء الجدول Kanory بنجاح.." & Space(20), msgstyle, "للمعلومية" Set b = Nothing اما لتعديل خصائص حقل موجود في الجدول استخدم التالي مع ملاحظة : ان اختلاف البيانات قي الحقل اذا كانت هنا بيانات ممكن تفقدها :::: <<<<<>>>>>>> Dim msgstyle Dim b As DAO.Database Dim strFieldName As String Set b = DBEngine.OpenDatabase(Me.txtPath) With b.TableDefs("Kanory").Fields("S_Name") .Properties.Append .CreateProperty("DisplayControl", dbInteger, AcControlType.acComboBox) .Properties.Refresh End With MsgBox Space(20) & "تم انشاء الجدول Kanory بنجاح.." & Space(20), msgstyle, "للمعلومية" b.Close Set b = Nothing3 points
-
هذا الكلام في المرفق ام برنامجك ........... وماهي رسالة الخطأ التي تظهر .....3 points
-
تم التطبيق على المرفق <<<<<<<>>>>>>> تجريبي (1).rar3 points
-
السلام عليكم ورحمة الله الاخ ABOU ELSAAD يمكنك استخدام الكود التالى Sub AbsCount() Dim ws As Worksheet, LR As Long Dim x As Long Dim a As Integer, b As Integer, d As Integer Dim C As Range, Abst As String Const Com = "," Set ws = Sheets("SS") x = 3 LR = ws.Range("AG" & Rows.Count).End(xlUp).Row Do While x <= LR For Each C In ws.Range("A" & x & ":AE" & x) If C.Value > 0 Then a = WorksheetFunction.Min(ws.Range("A" & x & ":AE" & x)) b = WorksheetFunction.Max(ws.Range("A" & x & ":AE" & x)) ab = b - a + 1 d = WorksheetFunction.Count(ws.Range("A" & x & ":AE" & x)) If ab = d And d > 1 Then Abst = " يوم " & " (" & a & " - " & b & ")" ws.Range("AL" & x) = Abst Else Abst = C.Value & Com & Abst ws.Range("AL" & x) = Left(Abst, Len(Abst) - 1) End If End If Next C Abst = "" x = x + 1 Loop End Sub2 points
-
من تبويب ملف file ثم خيارات options ثم متقدم advanced يوجد قوائم مخصصة custom lists تأكد من وجود أسماء الأيام والشهور باللغة العربية وإلا فيجب إضافتها كل عنصر في سطر وبالنسبة لتنسيق الأرقام فيجب اختيار منطقة عربية في لوحة التحكم في تنسيق التاريخ والأرفام بالتوفيق2 points
-
2 points
-
يمكنك استعمال هذه المعادلة =TEXTJOIN(CHAR(10),1,A2:C2) مع تغيير تنسيق الخلية إلى التفاف النص wrap text وإذا لم تكن دالة textjoin مدعومة فيوجد موضوع لي عن بدائل لها mastextjoin بالتوفيق2 points
-
طيب جرب المرفق هذا <<<<<<<>>>>>>>> al3beadlly.rar نافذة الرسائل بسيطة يمكن تلافيها وعدم ظهورها .....2 points
-
2 points
-
2 points
-
واضح الرسالة تظهر قبل الضغط على زر ارسال البيانات ... صحيح2 points
-
بعد إذن أخي الكريم @ابراهيم الحداد لا نحتاج لعكس الكلام لأنه يظهر الأرقام مقلوبة مثل 13 تظهر 31 وهكذا هذا جهدي المتواضع في هذا المجال Sub AbsDays() Dim ws As Worksheet, C As Range, LR As Long, x As Long Set ws = Sheets("SS") LR = ws.Range("AG" & Rows.Count).End(xlUp).Row For x = 3 To LR ws.Range("AI" & x) = "" For Each C In ws.Range("A" & x & ":AE" & x) If C.Value > 0 Then ws.Range("AI" & x) = ws.Range("AI" & x) & IIf(ws.Range("AI" & x) = "", "يوم ", " و") & C.Value Next C : Next x MsgBox "Done by mr-mas.com" End Sub بالتوفيق ترحيل أيام الغياب.xlsb2 points
-
جرب تغير هذا الكود <<<<<<>>>>>>>>> Fol.AllowMultiSelect = False بهذا ........... Fol.AllowMultiSelect = True2 points
-
2 points
-
2 points
-
تفضل <<<<<<<<<>>>>>>>>> Dim strSQL1 As String strSQL1 = "CREATE TABLE [kanory] ([ProductID] AUTOINCREMENT,[ProductName] TEXT(40) NOT NULL,[SupplierID] LONG,[BirthDate] DATETIME,[CategoryID] LONG,[QuantityPerUnit] TEXT(20),[UnitPrice] CURRENCY,[UnitsInStock] SMALLINT,[UnitsOnOrder] SMALLINT,[ReorderLevel] SMALLINT,[Discontinued] BIT NOT NULL,CONSTRAINT [PrimaryKey] PRIMARY KEY ([ProductID]));" DoCmd.RunSQL strSQL1 اسف اخي الكريم @عبد اللطيف سلوم يبدو ان المشاركيتن في في الوقت .... لكن الطريقتين مختلفتين للفائدة .....2 points
-
2 points
-
واياك استاذنا الفاضل ابا الحسن ... جزاك الله خيرا2 points
-
الحمد لله رب العالمين .... بالتوفيق يادكتور الله يجزاك خير حبينا الغالي ... اشكرك2 points
-
طيب ... جرب الكود هذا <<<<<<<<<>>>>>>>>> DoCmd.RunCommand acCmdSaveRecord If Val(outs) <= Val(a) Then Me.a = [Forms]![Form1]![a] - [Forms]![Form1]![outs] ElseIf Val(outs) > Val(a) And Val(a) > 0 Then MsgBox "الرصيد الحالي لا يغطي التسديد" ElseIf Val(a) = 0 And Val(outs) <= Val(m) Then Me.m = [Forms]![Form1]![m] - [Forms]![Form1]![outs] ElseIf Val(outs) > Val(m) And Val(a) = 0 Then MsgBox "التسديد اكبر من رصيد اول المدة" End If2 points
-
لم افهم ... اعذرني لكبر سني ... ممكن مثال للفهم2 points
-
طيب جرب الحدث التالي <<<<<<<<>>>>>>>>> DoCmd.RunCommand acCmdSaveRecord If Me.outs <= Me.a Then DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE t1 SET t1.a = [Forms]![Form1]![a]-[forms]![Form1]![outs] WHERE (((t1.kan_id)=[Forms]![Form1]![kan]))" DoCmd.Requery DoCmd.SetWarnings True ElseIf Me.outs > Me.a And Me.a > 0 Then MsgBox "الرصيد الحالي لا يغطي التسديد" ElseIf Me.a = 0 And Me.outs <= Me.m Then DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE t1 SET t1.m = [forms]![Form1]![m]-[Forms]![Form1]![outs] WHERE (((t1.kan_id)=[Forms]![Form1]![kan]))" DoCmd.Requery DoCmd.SetWarnings True ElseIf Me.outs > Me.m And Me.a = 0 Then MsgBox "التسديد اكبر من رصيد اول المدة" End If اشكرك يا بشمهندس ........ منكم تعلمنا2 points
-
طيب جرب المرفق حسب فهمي للموضوع <<<<<<<<<<>>>>>>>>>> اضفتا حقل ترقيم ... الخصم.accdb2 points
-
اعانك الله اخي عمر وعوضك خيرا ..... اخي الكريم .... نصيحة اخ .. دائما وابدا اعمل نسخ احتياطية لبرامجك سواءا وقت التصميم او وقت العمل عليه ....2 points
-
2 points
-
1 point
-
السلام عليكم كيف أضف حقول في التقرير الصفحة الثانية بعد إمتلاء الصفحة الأولى للعلم a3 وشكرا1 point
-
أ.محمد صالح شكرا جدا يا فندم عاجز عن الشكر شكرا جدا جدا انا عاجز عن شكرك يا فندم1 point
-
Sub Test() Dim a, v, w1 As Worksheet, w2 As Worksheet, dic As Object, s As String, i As Long, m As Long, cnt As Long Set w1 = Sheet1: Set w2 = Sheet2 Set dic = CreateObject("Scripting.Dictionary") a = w1.Range("A4").CurrentRegion.Value For i = 2 To UBound(a) s = a(i, 1) & Chr(2) & a(i, 2) & Chr(2) & a(i, 3) dic(s) = Empty Next i With w2 For i = 5 To .Cells(Rows.Count, 1).End(xlUp).Row s = Empty s = .Cells(i, 1) & Chr(2) & .Cells(i, 2) & Chr(2) & .Cells(i, 3) If Not dic.Exists(s) Then m = w1.Cells(Rows.Count, 1).End(xlUp).Row + 1 v = Split(s, Chr(2)) w1.Range("A" & m).Resize(1, 3).Value = v cnt = cnt + 1 End If Next i End With If cnt > 0 Then MsgBox "New Items Added = " & cnt, 64 Else MsgBox "No New Items", vbExclamation End Sub1 point
-
ينبغي مدارسة المعادلة وفهم بداية ونهاية كل نطاق ورقم الصف والعمود المطلوب وبإذن الله تستطيع الوصول للمطلوب الثاني بنفسك خالص دعواتي بالتوفيق1 point
-
لو تكرمتم ممكم اضافة عموددين الحالة واللغة فى القائمة والف شكر فى المف السابق1 point
-
مشاركة قاعدة البيانات على جهاز mycloudex2ultra الموضوع مطروح للأفكار والنقاش للأستفادة منه وهو يعتبر الجيل الجديد من السيرفيرات المصغرة توجد العديد من الأنواع . لكن هذا النوع الذي أعمل عليه و قمت بتجربته مشاركة قاعدة البيانات البسيطة و محدودة المستخدمين على جهاز كمبيوتر مشاكلها كثيرة وتتطلب الدعم الفني بصفة مستمرة . . . لكن حين الأنتقال للجيل الجديد تبدو المشاركة بسيطة وسلسة و مستوى أمان عالي على مستوى المستخدمين وقاعدة البيانات ومن مميزاتها : سهولة توصيله مع الرواتر النسخ المتماثل للسيرفير المصغر بواسطة تقنية RAID 1 و العديد من تقنيات النسخ النسخ الأحتياطي الأوتوماتيك للقاعدة الخلفية الربط المتباعد بين الفروع عن طريق ربط الجهاز بالأنترنت متجر لتنزيل التطبيقات المخصصة لقواعد البيانات و الصيانة و نشر المحتوى سهولة التعامل مع لوحة التحكم من مميزاته في حالة قيام المستخدم بحذف ملف بالخطأ من مجلد المشاركة يتم نقله إلى مجلد خاص TimeMachineBackup تطبيق ربط الطابعات و أجهزة الماسح الضوئي على السيرفير . يتطلب أشتراك رمزي مدفوع تحديث أوتوماتيك لــ Firmware يمكن أنشاء نموذج ووضع ال ip بالمستعرض داخل تطبيق الأكسيس حتى يمكن التعامل معه بسهولة كل هذه تعتبر الوجبة . . لكن ماهي النكهة . أنه : phpMyAdmin مدمج و مجاني ماعليك سوى تنزيله من متجر التطبيقات وهو تطبيق قواعد البيانات SQL أذا أردت تطوير قاعدة بيانات الأكسيس و الأنتقال لقواعد البيانات sql لا تحتاج سوى نصف ساعه . . والله الموفق1 point
-
1 point
-
أعتقد أنه إذا تم إعطاء فرصة للتاجر لرفع الفواتير فسيفتح ذلك أبوابا للفساد وسد هذا الباب هو السبب الرئيسي لعمل الفاتورة الالكترونية معلوماتي أن التاجر يقوم بفتح حساب في البنك ويأخذ ماكينة الصرف الصغيرة ويسدد العميل بالفيزا فيتم إصافة المبلغ لحساب التاجر والفاتورة الالكترونية هي الكشف الذي تخرجه الماكينة الصغيرة حيث يكون مسجلا به كل معلومات التاجر والمشتري والله أعلم1 point
-
Sub Test() Dim a a = GetDates(Range("D1").Value2, Range("F1").Value2) Range("D3").Resize(UBound(a)).Value = Application.Transpose(a) End Sub Function GetDates(ByVal startDate As Date, ByVal endDate As Date) Dim v() As Date, cnt As Long ReDim v(1 To CLng(endDate) - CLng(startDate) + 1) For cnt = LBound(v) To UBound(v) v(cnt) = CDate(startDate) startDate = CDate(CDbl(startDate) + 1) Next cnt GetDates = v If IsArray(v) Then Erase v cnt = Empty End Function or Sub Test() Dim sDate As Date, eDate As Date, r As Long sDate = Range("D1").Value2 eDate = Range("F1").Value2 Range("D3:D" & Rows.Count).ClearContents Do Until sDate > eDate r = r + 1 Range("D" & r + 2).Value = sDate sDate = sDate + 1 Loop End Sub1 point
-
ربما لو أرفقت ملفا به النتائج المتوقعة (الشكل النهائي للشيت) نتوصل بإذن الله لما تريد لأن المطلوب له أكثر من احتمال وأبسطها أن تكتب في أول خلية رأسية وليكن B3 =D1 ثم في الخلية التي تحتها B4 =IFERROR(IF(B3+1<=F$1,B3+1,""),"") مع سحب المعادلة لأسفل وتغيير تنسيق الخلايا إلى تاريخ بالتوفيق1 point
-
للأسف نماذج الاكسل لا تدعم الارتباط التشعبي بالشكل المعتاد ولكن يمكن التحايل على ذلك بوضع عنوان الارتباط في label وتنسيق لون الخط أزرق وتحته خط وكأنه ارتباط واستعمال هذا الكود في حدث النقر على التسمية Private Sub lblLink_Click() ActiveWorkbook.FollowHyperlink Address:="mr-mas.com", NewWindow:=True Unload Me End Sub مع تغيير رابط موقعي إلى عنوان الارتباط التشعبي بالتوفيق1 point
-
هذا ملفك بعد تنفيذ المطلوب التصفية بشرطين الفصل والنوع بالتوفيق قائمة فصل بنون وبنات.xlsx1 point
-
الاستاذ محمد صالح سبحان الله وكانك تقرا ما بخاطري عندما قمت بتجربة كود الاستاذ ابراهيم جزاه الله خيرا حدث ما قلته بالضبط فظهرت الارقام معكوسة فقمت بحذف StrReverse حتى تظهر الارقام بصورتها الصحيحة فاذا بحضرتك تفيض علي من كرمك بحل رائع فجزاك الله خير الجزاء وزادك من فضله1 point
-
1 point
-
يمكنك استعمال هذه المعادلة =IF(OR(Q6="",F6=""),"",IF(Q6>=250,"ناجح"&IF(F6="ذكر", "", "ة"),"له"&IF(F6="ذكر", "", "ا")&" برنامج علاجي")) بالتوفيق1 point
-
السلام عليكم ورحمة الله استخدم الكود التالى Sub AbsCount() Dim ws As Worksheet, LR As Long Dim x As Long, y As Integer Dim C As Range, Abst As String Const Com = "," Set ws = Sheets("SS") x = 3 LR = ws.Range("AG" & Rows.Count).End(xlUp).Row Do While x <= LR For Each C In ws.Range("A" & x & ":AE" & x) If C.Value > 0 Then Abst = Abst & C.Value & Com ws.Range("AL" & x) = StrReverse(Left(Abst, Len(Abst) - 1)) End If Next C Abst = "" x = x + 1 Loop End Sub1 point
-
1 point
-
السلام عليكم ورحمة الله كنت أنتظر أن يقوم أحد الإخوة الكرام بإنشاء ماكرو للقيام بهذه العملية وهذا لم يكن، لهذا قمت بتحضير ما تريده في الملف المرفق باستعمال المعادلات... وللضرورة قمت بتغيير التنسيقات على الجداول وإضافة المعادلات المناسبة لعمل المطلوب (يرجى أن لا تقوم بحذف الصفوف أو الأعمدة لئلا تخسر المعادلات)... يبقى لتغييراتك أن تقوم بحجز فقط عدد المناصب -عدد الأساتذة- حسب المواد في "جدول 1" (جدول المواد) وعدد الأفواج -عدد الأقسام- حسب الشعبة والمستوى- في "جدول 2" (جدول الأقسام) والمعادلات تقوم باللازم لملء الجداول الأخرى (حتى الجدول 3 في ورقة Data)... والله أعلم... جدول ديناميكي.xlsx1 point
-
Thank you very much for this trust. I am not expert, I am just a learner1 point
-
أخي الكريم أبو حنين إليك التعديل التالي (لم أفهم طلبك الأخير ..كيف لا تحتوي ورقة العمل غير على خلية واحدة ..حاول تربط النقطة بخلية محددة تكون فارغة) Sub TransferToSpecificSheet() Dim Cell As Range, T As String, LR As Long, LRT As Long Dim WS As Worksheet, Answer As Long Set WS = Sheets("1") LR = WS.Cells(35, 3).End(xlUp).Row T = WS.Range("A3").Value Application.ScreenUpdating = False If Not IsEmpty(WS.Range("A3")) Then Range("B6:G" & LR).Copy With Sheets(T) LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1 .Cells(LRT, 2).PasteSpecial xlPasteValues End With Answer = MsgBox("هل تريد أن تمسح البيانات في ورقة 1 أم لا؟", vbYesNo + vbQuestion) If Answer = vbYes Then Sheets("1").Activate Sheets("1").Range("A3,C6:C35,F6:G35").Select Selection.ClearContents Else: End If Else MsgBox "الخلية المحددة فارغة لذا لن يتم تنفيذ الكود": Exit Sub End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تقبل تحياتي1 point