اذهب الي المحتوي
أوفيسنا

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

  1. Ali Mohamed Ali

    Ali Mohamed Ali

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


    • نقاط

      48

    • Posts

      11,621


  2. د.كاف يار

    د.كاف يار

    الخبراء


    • نقاط

      9

    • Posts

      1,681


  3. kaser906

    kaser906

    الخبراء


    • نقاط

      5

    • Posts

      1,411


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

    • نقاط

      4

    • Posts

      1,746


Popular Content

Showing content with the highest reputation on 19 أغس, 2019 in all areas

  1. اخي الكريم طلبك موجود ضمن الكود و لست بحاجة لانشاء رسالة اخرى في حال ان الاتصال فشل سوف تظهر الرسالة ادناه VBA.MsgBox "Error " & err.Number & " (" & err.Description & ")" لكن تستطيع اضافة رسالة في حال نجاح الاتصال و لا انصح بها لأنه في كل الاحوال سيتم استخدام الكود في نموذج الواجهة الرئيسية ففي كل مرة يتم الدخول للواجعة سوف تظهر رسالة تفيد بنجاح الربط و هذا غير منطقي شكرا لك...
    3 points
  2. الاخوة الاعزاء تجدون في المرفقات فكرة في طور التطوير لعمل قوائم بأبسط الطرق و بالأدوات المتاحة آمل المزيد من اقتراحاتكم شكرا لكم ... . برنامج شئون الموظفين.rar
    3 points
  3. أحسنت أستاذ مجدى عمل رائع جعله الله في ميزان حسناتك
    3 points
  4. استاذى الكريم الأمر في غاية البساطة بالنسبة لملفك فعليك بالضغط كليك يمين على اسم الصفحة التي تظهر لديك بالملف ثم الضغط على UNhide كما بالصور لإختيار الصفحة التي تريد اظهارها
    3 points
  5. وعليكم السلام-اهلا بك في المنتدى -تفضل بلاغات.xlsm
    3 points
  6. أحسنت أستاذ أبو اَمنة عمل رائع بارك الله فيك وجعله في ميزان حسناتك
    3 points
  7. بارك الله فيك استاذ مجدى وجزاك الله كل خير
    3 points
  8. وعليكم السلام-تفضل هذا الكود Option Explicit Sub opening_multiple_file() Dim i As Integer With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True .Filters.Clear .Filters.Add "Excel Files", "*.xls*" If .Show = True Then For i = 1 To .SelectedItems.Count Workbooks.Open .SelectedItems(i) Next i End If End With End Sub
    3 points
  9. الأمر بسيط وسهل جدا عدل في الكود الى رقم الصف الذى تريده عليك بتغيير الرقم 24 الى الرقم المراد بارك الله فيك
    3 points
  10. 3 points
  11. فورم ترحيل بيانات عمودى وافقى الفيديو الصور
    2 points
  12. If Not IsNumeric([أسم الحقل ]) Then MsgBox "يجب ادخال ارقام في هذا الحقل", 48, "ادخـال خـاطـئ !" End if If Len([أسم الحقل]) <> 10 Then MsgBox "يجب ادخال عشرةارقام في هذا الحقل", 48, "ادخـال خـاطـئ !" End if ::بالتوفيق::
    2 points
  13. أحسنت استاذ عبد اللطيف عمل رائع جعله الله فى ميزان حسناتك ورحم الله والديك
    2 points
  14. أحسنت استاذ مجدى بارك الله فيك وزادك الله من فضله
    2 points
  15. تفضل .... برنامج مسابقة الحماية والاستمار.accdb
    1 point
  16. DoCmd.RunSQL "DELETE data.*, InvoiceTT.InvoiceNum, InvoiceTT.ItemId, InvoiceTT.Movement " & vbCrLf & _ "FROM InvoiceTT " & vbCrLf & _ "WHERE (((InvoiceTT.InvoiceNum)=[forms]![InvoiceHT_F]![InvoiceHT_SubF].[Form]![InvoiceNum]) AND ((InvoiceTT.ItemId)=[forms]![InvoiceHT_F]![InvoiceHT_SubF].[Form]![ItemId]) AND ((InvoiceTT.Movement)=[forms]![InvoiceHT_F]![InvoiceHT_SubF].[Form]![Movement]));" DoCmd.Requery جرب هذا InvoiceSale_8.accdb
    1 point
  17. اخى الكريم تفضل لا يوجد أفضل من هذا فاتورة على الفورم 2.xlsm
    1 point
  18. 1 point
  19. على كل حال اذا كنت تريدها بواسطة الماكرو Option Explicit Sub sum_befor_date() Dim i%, x%, s#, My_date As Date Dim k%: k = 3 My_date = [CA1] Range("CA3", Range("CA2").End(4)).ClearContents x = Cells(1, Columns.Count).End(1).Column - 1 Do Until Cells(k, 3) = vbNullString For i = 3 To x Step 2 If CDate(Cells(3, i + 1)) > My_date Then Exit For s = s + Cells(3, i) Next Cells(k, "CA") = s: s = 0 k = k + 1 Loop End Sub
    1 point
  20. اخ فاضل افادنى بالحل و لكى تعم الفائده الحل هو =SUMPRODUCT(C3:BY3*(D3:BZ3<=$CA$1)*ISODD(COLUMN(C3:BY3))) شكرا استاذ سليم
    1 point
  21. السلام عليكم الحل على حسب عنوان الموضوع أخي @hassam0k New Microsoft Access Database (2).accdb افتح استعلام Q1 و انظر النتيجة
    1 point
  22. أخي @ازهر عبد العزيز عندما يكون الطلب واضح ويكون المثال متواجد ومبني بشكل صحيح عندها تسهل الإجابة بإذن لله ::بالتوفيق::
    1 point
  23. ===== تم التعديل على خصائص النموذج من مرئي إلى غير مرئي.. وتم تطبيقه مئة مئة مئة بالمئة.. شكرا لك @د.كاف يار شكرا لكافة المشرفين الذين أتحفونا بجميل أفكارهم .. وروعة أرواحهم.. @ابوآمنة @ابو ياسين المشولي @ابو عارف أنرت بالضـــــــــــــياء دربنا في دوحة يحــــيطها الحـنان بعلمــــــــــــــك البديع نرتقي نحقق الأهداف باطمئنان
    1 point
  24. اخي لدي مشروع قريب من الذي لديك قد تجد فيه ما يفيدك تفضل في المرفقات برنامج شئون الموظفين.rar
    1 point
  25. فبل التحديث If Len(رقم_الجوال) <> 10 Then MsgBox " فـضـلاً أدخـل عـشـرة أرقـام فـقـط ولـيـس اقـل او اكـثـر ", vbExclamation, " : خـطـاء " cancel = True 'هذاالسطر والا تحته يعيد التركيز لنفس الحقل' cancel = True Me.رقم_الجوال.Undo End If عند الضغط على مفتاح Dim Chkstr As String Chkstr = "0123456789" If KeyAscii > 26 Then 'اي ان المفتاح الذي تم نقره ليس من ضمن مفاتيح التحكم مثل Ctrl If InStr(1, Chkstr, Chr(KeyAscii)) = 0 Then KeyAscii = 0 MsgBox " فـضـلاً أدخـل أرقـام فـقـط ولـيـس حـر و ف ", vbInformation, " : خـطـاء " End If End If
    1 point
  26. اخي الكريم هذا كود بسيط لعملية الربط المهم ان تكون قاعدة البيانات في نفس مسار البرنامج انشئ موديل و الصق التالي مع التعديل كما هو موضح Option Compare Database Option Explicit Public Function updateTableLinks() On Error GoTo updateTableLinks_Err Dim varThis As Variant Dim strBEFileSpec1 As String dim x x=CurrentProject.Path & "\" & "اسم قاعدة البيانات"& ".mdb" ' او ضع مسار قاعدة البيانات strBEFileSpec1 = x For Each varThis In CurrentDb.TableDefs With varThis If Trim(Nz(.Connect)) Like ";DATABASE=*" Then .Connect = ";DATABASE=" & strBEFileSpec1 .RefreshLink End If End With Next varThis updateTableLinks_Exit: Exit Function updateTableLinks_Err: If Err.Number > 0 Then Resume Next Else MsgBox Err.Description Resume updateTableLinks_Exit End If End Function في حدث عند الفتح في نموذج الواجهة استدعي Call updateTableLinks
    1 point
  27. @العنكوش تفضل اخي اسم المستخدم hussam كلمة السر 1234 تربية_حاسبات.rar
    1 point
  28. @العنكوش اخي الكريم لدي مشروعي السابق يخص الطلاب والهيئة التدريسية وحضور وانصراف الموظفينن وتسجيل غيابات الطلبة وحساب كل طال عدد محاظرات كل مادة الغائب فيها . والمقررات الدراسية وسجل درجات وتقريبا كل شيء يخص كليتنا . حجمه 11 ميكا حاولت اضغطه ببرنامج وينرار واصبح حجمه 4 ميكا ولا استطيع ارساله .... اذا هناك طريقة استطيع بها ارسال الملف لهذا المنتدى ارجو ان تخبروني بها
    1 point
  29. اريد مثل الصورة الاول بدون استعمال زر الجديد لا اريد مثل الصورة الثاني عند نقر على زر الجديد يجدد مربع النص ( باركود ) و يجدد مربع النص ( عدد ) اريد الكود لمربع النص ( باركود ) في صور الثانية بدن استعمال زر جديد
    1 point
  30. السلام عليكم شكرا على المشاركة حاليا يمكن تغيير اللغة من اسفل صفحة المنتدى اللي اللغة المسماة أوفيسنا. فيتغير بذلك التنسيق الي المطلوب
    1 point
  31. اذا كانت الاجابة صحيحة اضغط عليها حتى تعم الفائدة
    1 point
  32. جرب هذا الماكرو Private Sub ComboBox1_Change() Application.EnableEvents = False On Error Resume Next ''''''''''''''''''''''''''''' Dim sheet_to As Worksheet Dim t$: t = ComboBox1.Value Dim My_name$ Dim My_rg As Range Select Case t Case "راسب": My_name = "رسوب" Case "ناجح": My_name = "ناجح" Case "دور ثانى": My_name = "دور ثان فى" End Select Set My_rg = Sheets("الشيت").Range("a4").CurrentRegion On Error Resume Next Sheets(My_name).Cells.Clear My_rg.AutoFilter 20, t My_rg.SpecialCells(12).Copy Sheets(My_name).Range("a4") If Sheets("الشيت").FilterMode Then Sheets("الشيت").ShowAllData: My_rg.AutoFilter End If Application.EnableEvents = True End Sub الملف مرفق Shool.xlsm
    1 point
  33. تفضل لك ما طلبت فاتورة على الفورم2.xlsm
    1 point
  34. تفضل فاتورة على الفورم2.xlsm
    1 point
  35. عليك السلام ورحمة الله وبركاته ممكن هكذا على حجم ورق A4 وأحيانًا ويمكن تقليل أو زيادة عرض أي عمود مع الاحتفاظ بظهور الكتابة فقد تم عمل احتواء مناسب للخلايا test.xlsx
    1 point
  36. جيد جداً شكرا لك اخي ..... هذا الجواب صحيح ..... هذا ما اريد ....
    1 point
  37. 1 point
  38. يمكنك رؤية هذا الفيديو https://www.youtube.com/watch?v=tAcC_GTZ38o
    1 point
  39. وعليكم السلام , اهلا بك اخى الكريم فى المنتدى عليك بوضع هذا الكود فى حدث الصفحة التى تقوم بالكتابة عليها Private Sub Worksheet_Change(ByVal Target As Range) Cells.Select Selection.Rows.AutoFit Selection.Columns.AutoFit Range("A1").Select End Sub وذلك عن طريق كليك يمين فى الأسف على اسم الصفحة ثم View Code ستفتح لك نافذة اخرى عليك لصق هذا الكود بها بارك الله فيك وموفق ان شاء الله
    1 point
  40. تفضل جلب البيانات بثلاث شروط2.rar
    1 point
  41. بالتأكيد هذا يسمى ابداع احسنت استاذى الكبير سليم عمل رائع بارك الله فيك وجعله فى ميزان حسناتك واكثر الله من امثالك وزادك الله من فضله
    1 point
  42. تفضل 1تقريب.xlsx
    1 point
  43. وعليكم السلام استاذى الكريم كان عليك استخدام خاصية البحث فى المنتدى تفضل https://www.officena.net/ib/topic/23984-برنامج-إدارة-العقارات-تأجير-تسديد-مصروفات-تقارير-برنامج-جاهز/?tab=comments#comment-119974 https://www.officena.net/ib/topic/25099-برنامج-عقارات-الالكتروني/?tab=comments#comment-118446 https://www.officena.net/ib/topic/22083-برامج-لمكتب-عقارات/?tab=comments#comment-102319
    1 point
×
×
  • اضف...

Important Information