اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

  1. jjafferr

    jjafferr

    أوفيسنا


    • نقاط

      15

    • Posts

      9,724


  2. Ali Mohamed Ali

    Ali Mohamed Ali

    المشرفين السابقين


    • نقاط

      5

    • Posts

      11,621


  3. ابو ياسين المشولي

    • نقاط

      3

    • Posts

      1,746


  4. سليم حاصبيا

    سليم حاصبيا

    أوفيسنا


    • نقاط

      3

    • Posts

      8,723


Popular Content

Showing content with the highest reputation on 28 يول, 2019 in all areas

  1. حياك الله 🙂 قوانين المنتدى تقتضي ان يكون هناك موضوع لكل سؤال ، وبما هذا الطلب جديد ، فرجاء عمل سؤال له ، وفي الواقع سؤالك يحتاج مزيد من التوضيح ، فلما تضع السؤال ، يفضل ان تضع فيه هذه الجزئية من برنامجك ، علشان الشباب يساعدوك ، اما الشياب ، فيقولون لكم تصبحون على خير جعفر
    3 points
  2. الامر On Error Resume Next جدا خطير ، ويجب ان يُستعمل في حالات جدا خاصة 🙂 بينما كود اصطياد الخطأ الذي وضعته انا ، جدا مرن ، ويستوعب اي عدد من الاخطاء ، ويمكن معالجة كل نوع منها بطريقة خاصة 🙂 شوف مثلا اصطياد هذه الاخطاء ، وهذا كود من احد برنامجي : Exit Sub ProcError: Select Case Err Case 7874 'could not find QueryDef Resume Next Case 9 'Worksheet doesn't exist objXLWb.Worksheets.Add Set objXLSheet = objXLWb.ActiveSheet objXLSheet.Name = strWorkSheet Resume Next Case 1004 'Workbook doesn't exist, make it objXLApp.Workbooks.Add Set objXLWb = objXLApp.ActiveWorkbook objXLWb.SaveAs strWorkBook, FileFormat:=strSaveAs Resume Next Case 53 'file not found Resume Next Case 3270 'Field Caption not found, use field name objXLCell(, i + 1) = rs.Fields(i).Name Resume Next Case 3061 'too few parameters, expected 1 or more 'this error occurs when trying to run a query which needs its parameters from a Form, 'the Form should be open with the parameter, then this code take the values properly Dim qdf As QueryDef Dim prm As Parameter 'Set qdf = CurrentDb.QueryDefs("strSql") Set qdf = CurrentDb.CreateQueryDef("NewQueryDef", strSql) For Each prm In qdf.Parameters prm.Value = Eval(prm.Name) Next prm Set rs = qdf.OpenRecordset(dbOpenDynaset) DoCmd.DeleteObject acQuery, "NewQueryDef" Resume Next Case Else DoCmd.Hourglass False MsgBox Err.Number & " " & Err.Description 'Stop 'OkNotOk = "NotOk" Exit Sub Resume 0 End Select End Sub جعفر
    2 points
  3. وعليكم السلام 🙂 تفضل: Private Sub Command42_Click() on error goto err_Command42_Click Forms!Violations_Form_Share!Violations_Table_subform.SetFocus DoCmd.GoToRecord , , acPrevious Exit_Command42_Click: exit sub err_Command42_Click: msgbox "عفوا هذا اول سجل" resume Exit_Command42_Click End Sub كود السهم للأمام Private Sub Command41_Click() on error goto err_Command41_Click Forms!Violations_Form_Share!Violations_Table_subform.SetFocus DoCmd.GoToRecord , , acNext Exit_Command41_Click: exit sub err_Command41_Click: msgbox "عفوا هذا اخر سجل" resume Exit_Command41_Click End Sub وتقريباً نفس المشكلة في التقرير حيث يحتوي على صور ... في حال وجود سجلات يعمل بشكل ممتاز .. ولكن في حال عدم وجود سجلات وعمل بحث أو معاينة يكون الخطأ في الكود ... فإذا كان بالإمكان وجود حل لذلك Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) on error goto err_Detail_Format Me![ImageFrame1].Picture = Me![Picture1] Me![ImageFrame2].Picture = Me![Picture2] Me![ImageFrame3].Picture = Me![Picture3] Me![ImageFrame4].Picture = Me![Picture4] Exit_Detail_Format: exit sub err_Detail_Format: if err.number=2220 then resume next else msgbox err.number & vbcrlf & err.description endif End Sub جعفر
    2 points
  4. وعليكم السلام 🙂 اذا كان قصدك ان عندك اكثر من جدول ، وهذه الجداول مرتبطة بعلاقة مع بعض ، وفي الجدول 1 عندك حقل مفهرس وغير قابل للتكرار (مثلا ID) ، وفي الجدول 2 عندك حقل ID ، والجدولين مربوطين بالعلاقة التالية: . فعند حذف اي سجل من الجدول 1 (مثلا ID=5 ) ، فإن جميع سجلات ID=5 في الجدول 2 سوف تحذف تلقائيا (اذا كان المربع الذي عليه السهم ، صح) 🙂 . جعفر
    2 points
  5. يمكن للجميع الان اضافة الاسم الحقيقي فى البروفايل دون تغيير اسم الدخول و المشاركة و ذلك لسهولة التواصل و هذا عن طريق اعادة استخدام خاصية الرتبة السابقة ، و التي لم نعد نستخدمها حاليا فى الموقع و الخطوات كالتالي ا- اذهب الي الملف الشخصي من اعلى يسار صفحة المنتدى 2- اختار تعديل الملف الشخصي 3- قم بتعديل الاسم فيظهر الاسم الفعلي فى صفحة الروفايل كما يلي و بالتالي ستظهر فوق الصورة فى كل المشاركات مثال:
    1 point
  6. بيانات الموظف ومرفقات منوعة للموظف الفيديو الصور
    1 point
  7. ممتاز ، ولكن ناقصك ، اذا كان في اخطاء اخرى غير 7847 ، فعليك عمل الكود هكذا : On Error GoTo MyErr ثم الكود MyErr: If Err.Number = 7847 Then MsgBox " هذا الملف موجود سابقا ", vbInformation, " : عنوان الرساله " else msgbox err.number & vbcrlf & err.description end if جعفر
    1 point
  8. تسلم اخي جعفر انا استخدم هذا On Error GoTo MyErr ثم الكود MyErr: If Err.Number = 7847 Then MsgBox " الرساله ", vbInformation, " : عنوان الرساله " End If وهو ممتاز جدا يعرفك في الاخطاء وكما قلت في حجات استخدم اخفاء الاخطاء اللي نتعلم عنه
    1 point
  9. ولك بمثل ما دعوت لى وزيادة والحمد لله الذى بنعمته تتم الصالحات
    1 point
  10. تم اضافة الحماية على الملف فى المشاركة السابقة لعدم العبث بالخلايا والمعادلات بارك الله فيك
    1 point
  11. في الواقع يمكننا ان نتوسع في كود الصور اكثر ، حتى نخفي الصوره الغير موجودة : Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) on error goto err_Detail_Format dim int_Which_Picture int_Which_Picture=1 Me![ImageFrame1].Picture = Me![Picture1] int_Which_Picture=2 Me![ImageFrame2].Picture = Me![Picture2] int_Which_Picture=3 Me![ImageFrame3].Picture = Me![Picture3] int_Which_Picture=4 Me![ImageFrame4].Picture = Me![Picture4] Exit_Detail_Format: exit sub err_Detail_Format: if err.number=2220 then if int_Which_Picture=1 then Me![ImageFrame1].Picture ="" elseif int_Which_Picture=2 then Me![ImageFrame2].Picture ="" elseif int_Which_Picture=3 then Me![ImageFrame3].Picture ="" elseif int_Which_Picture=4 then Me![ImageFrame4].Picture ="" endif resume next else msgbox err.number & vbcrlf & err.description endif End Sub جعفر
    1 point
  12. نعم اخي جعفر بس انا قلت مادتم انه متاكد من الكود انه سليم فقط اعطيته كود تخطي الاخطاء ما كنت عارف انه يريد تفاصيل بالاخطاء والى اخر
    1 point
  13. لا يا ابو ياسين ، هذا الكود موجود في حدث "الحالي" للنموذج ، واذا وضعت الكود اعلاه ، فالبرنامج ما راح يعطيه اي رسالة خطأ !! وطبعا احنا نعرف ان حدث "الحالي" من اهم الاحداث ، والكثير من الاكواد تكون فيه ، فما بيعرف شو الاخطاء الاخرى في الحدث هذا !! نعم ، ممكن نخليه على اوامر الزر الاخرى اللي طلبها السائل 🙂 جعفر
    1 point
  14. يمكنك استخدام هذا قبل الكود اذا كان الكود كما تقول On Error Resume Next Me![ImageFrame1].Picture = Me![Picture1] Me![ImageFrame2].Picture = Me![Picture2] Me![ImageFrame3].Picture = Me![Picture3] Me![ImageFrame4].Picture = Me![Picture4] End Sub
    1 point
  15. يارك الله فيك اخي علي وهذا كود اخر يعتمد على Dictionary لتحديد المدارس المطلوبة و على Auto Filter لكل مدرسة اظن انه أسرع لنقل ال Data الى الصفحة المطلوبة Option Explicit Sub test() '====>>> CREATED BY SALIM ON 28/7/2019 Application.ScreenUpdating = False '+++++++++++++++++++++++++++++++++++++++ Start Of DIM Dim Fst As Worksheet: Set Fst = Sheets("Data") 'First Sheet Dim Sec As Worksheet ' Seconde sheet Dim LRU% ' LRU Num of Rows in First sheet column U Dim i%, ky, m%: m = 6 'm row's number when the data will start Dim D As Object ' D Dictionary Dim Fst_Rg As Range 'My range On first sheet '+++++++++++++++++++++++++++++++++++++++ End Of DIM Set D = CreateObject("Scripting.Dictionary") LRU = Fst.Cells(Rows.Count, "U").End(3).Row Set Fst_Rg = Fst.Range("a2").Resize(LRU, 30) '''''''''''''''''''''''''''Start Of For_next Loop to fill the Dictionary For i = 3 To Fst_Rg.Rows.Count If Not D.exists(Fst.Cells(i, "U").Value) And _ Len(Fst.Cells(i, "U")) > 3 Then D.Add Fst.Cells(i, "U").Value, "" End If Next i '''''''''''''''''''''''''''End Of For_next Loop to fill the Dictionary '+++++++++++++++++++++++++++++++++ fil All sheets with auto filter For Each ky In D.keys Set Sec = Sheets(ky) Sec.Range("c6").CurrentRegion.ClearContents ' Clean Up the Data in Seconde sheet Fst_Rg.AutoFilter 21, CStr(ky) 'filter by column(21)==>> N Fst_Rg.Cells(1, 1).Resize(LRU - 1, 20).SpecialCells(12).Copy _ Sec.Range("C" & m) Next ky '++++++++++++++++++++++++++++++++++++ If Fst.FilterMode Then _ Fst.ShowAllData: Fst_Rg.AutoFilter '====== Clear Autofilter from sheet Data '++++++++++++++++++++++++++++++++++++++ Clean Up the Memory D.RemoveAll: Set D = Nothing: Set Fst_Rg = Nothing Set Fst = Nothing: Set Sec = Nothing '++++++++++++++++++++++++++++++++++++++ Application.ScreenUpdating = True End Sub
    1 point
  16. أشكرك أستاذي الفاضل علي لك مني فائق الأحترام و التقدير ولكن ما هو تصريح الدخول هذا و أريد أن أحمي بعض الأعمدة و الخلايا في الشيت من التعديل او الكتابة لحماية المعادلات
    1 point
  17. هذا هو الكود المستخدم كما اخبرك الأستاذ سليم -الأمر في غاية البساطة فيمكنك تتبع هذا الكود وفهمه Option Explicit Sub Save_for_Me() Dim answer As Byte Dim M As Worksheet: Set M = Sheets("Main") Dim F As Worksheet: Set F = Sheets("For_Save") Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row + 1 Dim fnd As Range Set fnd = F.Columns("A").Find(M.Cells(2, 1), lookat:=1) If Not fnd Is Nothing Then answer = MsgBox("هذه المعلومة موجودة" & Chr(10) & _ " هل تريد المتابعة", 36, "Attention") If answer = 6 Then F.Cells(lrF, 1) = M.Cells(2, 1) F.Cells(lrF, 2) = Date F.Cells(lrF, 3) = Time Exit Sub End If Else F.Cells(lrF, 1) = M.Cells(2, 1) F.Cells(lrF, 2) = Date F.Cells(lrF, 3) = Time End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim F As Worksheet: Set F = Sheets("For_Save") Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row If Target.Address = "$A$2" Then Save_for_Me lrF = F.Cells(Rows.Count, 1).End(3).Row If lrF = 1 Then GoTo End_Me Sheets("Main").Cells(2, "G").Resize(, 3).Value = _ F.Cells(lrF, 1).Resize(, 3).Value End If End_Me: Application.EnableEvents = True End Sub Sub Undo_for_me() Dim F As Worksheet: Set F = Sheets("For_Save") Application.EnableEvents = False Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row If lrF = 1 Then GoTo End_Me F.Cells(lrF, 1).Resize(, 3).ClearContents lrF = F.Cells(Rows.Count, 1).End(3).Row Sheets("Main").Cells(2, "G").Resize(, 3).Value = F.Cells(lrF, 1).Resize(, 3).Value End_Me: Application.EnableEvents = True End Sub Sub Clear_all() Application.EnableEvents = False Dim F As Worksheet: Set F = Sheets("For_Save") Dim lrF%: lrF = F.Cells(Rows.Count, 1).End(3).Row Dim answer As Byte answer = MsgBox("أنت تقوم بمسح كل البيانات في الصفحة For _save " & Chr(10) & _ " هل انت متأكد من هذا", 1048628, "Attention") If answer <> 6 Then GoTo End_Me If lrF = 1 Then lrF = 2 F.Cells(2, 1).Resize(lrF - 1, 3).ClearContents Me.Cells(2, "G").Resize(, 3).ClearContents End_Me: Application.EnableEvents = True End Sub
    1 point
  18. وعليكم السلام-اهلا بك في المنتدى test.xlsx
    1 point
  19. وعليكم السلام -تفضل لك ما طلبت كما تم عمل شاشة دخول بكلمة سر يمكنك فقط اختيار الإسم من الكمبوبوكس وهو : Abdelkarem وكلمة السر : 1111 شحن.xls
    1 point
  20. هل تستخدم نظام صلاحيات حسب المناطق( فروع متعدده ) ؟ اذا كان كذلك فلا أرى أي منطق من تسجيل الدخول باستخدام أسم المنطقة لذلك يجب عليك اضافة اسم المنطقة اثناء اضافة المستخدم الجديد للنظام وعند تسجيل الدخول باسم المستخدم يتعرف النظام عليه يتبع لأي منطقة ::بالتوفيق::
    1 point
  21. اخي بلال 🙂 رجاء لا تفتح موضوا آخر لنفس السؤال (انا دمجت الموضوعين معا 🙂 ) ، وكلمة "للرفع" تكفي لجعل بقية الاعضاء يرون الموضوع 🙂 وما شاء الله ، اخوي @kanory متابع معاك ، فأعطه الفرصة حتى يرد 🙂 جعفر
    1 point
  22. بعد اذن الأستاذ سليم -تفضل كود واحد يرحل جميع البيانات الى جميع الادارات وفق اسم الادارة ونوع المدرسة2.xlsm
    1 point
  23. فورم اظهار القيم الموجودة بالخلايا الفيديو الصور الفورم عند الفتح الفورم عند التسجيل القيمة الموجودة فى الخلية.rar
    1 point
  24. أولا من اول نظرة لحجم الملف لاحظت انه كبير جدأ حوالي واحد ميغا فمن الطيبعي ان يكون بطيئاً حاول التقليل من التنسيقات الملونة والتنسيقات الشرطية لان كل هذا يؤثر على السرعة الخلايا المدمجة علة العلل و عدو المعادلات والأكواد الأول حاول قدر الامكان التخفيف منها ثانيا لما لا تقوم بتحيمل الكود بشكل يمكن قرائته استعمل اشارة الكود الموجودة في القائمة عنك 1-اضغط اولا على الايقونة <> في الشرط العلوي للمشاركة 2- انسخ الكود الى النافذة التي تظهر 3-اضغط على اضف للمشاركة
    1 point
  25. آسف معادلة التقريب التي في آخر ملفين تم إرفاقها فيها أخطاء كثيرة (استعجلت في إرفاقها قبل التجربة) أرجو تجربة المرفق هنا وبإذن الله لن تجد فيه أخطاء أكرر اعتذاري مرة أخرى وفقك الله Book9.xls
    1 point
  26. وعليكم السلام بعد اذن استاذنا الكبير بالتأكيد سليم حاصبيا وذلك لأن هذه المعادلة معادلة مصفوفة فلابد من الضغط على Ctrl+Shift+Enter وليس Enter فقط تفضل Explain_2.xlsx
    1 point
  27. ابحث في المنتدى هناك الكثير من الموضوعات حول صلاحيات المستخدمين مثل هذا على سبيل المثال ....
    1 point
  28. rigth Click على اي زر من الازرار ثم Assign Macro ثم Edit
    1 point
  29. شكرا لك اخوي خالد ، بحثت عن المجاميع في المكان الخطأ ، فما لقيته وكما قال اخوي خالد: . . . جعفر
    1 point
  30. اذا كان المطلوب جمع قيمة عمود واحد فيمكن الجمع بدون استخدام دالة sum حيث ان من خصائص هذا النموذج امكانية اعداد مجاميع للحقل المطلوب مع تاييدي لرد استاذي الفاضل جعفر
    1 point
  31. اخوي خالد اعطاك كود طويل ، خليني اعطيك كود اقصر 🙂 =[n1] & [n2] & [n3] & [n4] & [n5] & [n6] اذن يصبح الكود اعلاه: ="0" & [n1] & [n2] & [n3] & [n4] & [n5] & [n6] & "0" جعفر
    1 point
  32. أحييك أخى الزيارى حاولت أدخل وأشوف عالم الباركود ده فلم أجد شيئا ولا مؤاخذه ما كنتش شايف أنك وراء الباب المرة اللى جايه هدخل بشويش بارك الله فيك وجازكم عنا خيرا أخوك مختار
    1 point
×
×
  • اضف...

Important Information