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

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

  1. ابوخليل

    ابوخليل

    أوفيسنا


    • نقاط

      8

    • Posts

      11,717


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

    سليم حاصبيا

    أوفيسنا


    • نقاط

      7

    • Posts

      8,723


  3. jjafferr

    jjafferr

    أوفيسنا


    • نقاط

      7

    • Posts

      9,753


  4. ابو جودي

    ابو جودي

    أوفيسنا


    • نقاط

      4

    • Posts

      6,503


Popular Content

Showing content with the highest reputation on 23 مار, 2020 in all areas

  1. فيك الخير والبركة استاذنا الفاضل جعفر ادامك الله ذخرا لإخوانك
    4 points
  2. لم اطلع على المرفق ولكني عملت لك هذا حسب ما فهمت Dim i As Integer Private Sub ID_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then i = i + 1 If i = 3 Then MsgBox "اعمل الإجراء" Exit Sub End If Else i = 0 End If End Sub test1.mdb
    4 points
  3. قبل فتح التطبيق يتم فقط اضافة ملفات لتنسيقات الصوت والفيديو المختلفة داخل المجلد المرفق باسم sound files يا عينى ع الدلع او بعد فتح التطبيق يتم الضغط على زر الأمر تحديث المكتبة القسم الايمن من الشاشة هو التحكم فى مشغل الوسائط برنامج الميديا بلاير الجزء الاوسط هو التنقل بين الاذاعة الصوتية وتعمل اون لاين او مكتبة ملفاتك من المجلد Sound files واسفل قائمة التشغيل التى تحتوى على الملفات خصائص واعدادات التشغيل والتكرار حاجه دلع الجزء الايسر وهو خاص بالتحكم فى الصوت لجهاز الحاسوب بس خلاص اسف انا باتصفح من الجوال مش قادر اعمل تنسيق للموضوع اكتر من كده ولا عارف ارفق صور فى انتظار ردكم بعد التجربة وفى الختام اتوجه بكل الشكر والتقدير والعرفان بالجميل لكل اساتذتى جميعا واخوانى فى هذا الصرح الشامخ الذين اتعلم منهم دائما وابدا اخص بالشكر الاستاذ القدير @jjafferr 🌹 حيث اننى دمجت بهذا المرفق الكثير مما قدمه من أفكار وتوجيهات عبر اشهر وسنوات وكذلك الاستاذ القدير @ابوخليل 🌹 كذلك استخدمت هنا الكثير من الاكواد التى تعلمتها منه عبر اشهر سنوات وباقى كوكبة اساتذتى الفضلاء واخوانى كل الشكر لكم 🌹🌹🌹 Digital Player App.zip
    3 points
  4. أولاً في هذه الحالة لست بحاحة الى arr_num ثانياً الكود الصحيح Option Explicit Sub give_data() If ActiveSheet.Name <> "data" Then Exit Sub Dim Laste_Row%, k%, m%, i% Dim arr Dim rg As Object Laste_Row = Sheets("data").Cells(Rows.Count, 1).End(3).Row Sheets("data2").Range("A3").Resize(3000, 3).ClearContents Set rg = CreateObject("system.collections.arraylist") i = 3 With rg Do Until i > Laste_Row If Not .Contains(UCase(Range("h" & i).Value)) Then .Add UCase(Range("h" & i).Value) i = i + 1 Loop arr = .toarray End With m = 3 For i = LBound(arr) To UBound(arr) For k = 3 To Laste_Row% If Sheets("data").Cells(k, "H") = arr(i) Then With Sheets("data2").Cells(m, 1) .Value = Sheets("data").Cells(k, "A") .Offset(, 1) = Sheets("data").Cells(k, "Y") .Offset(, 2) = Sheets("data").Cells(k, "H") m = m + 1 End With End If Next Next Set rg = Nothing: Erase arr End Sub
    3 points
  5. أحسنت استاذ محمد بارك الله فيك وزادك الله من فضله تم التجربة ويعمل بكل كفاءة
    2 points
  6. السلام عليكم 🙂 نقدر نعمل ملف XML ونضيف فيه القائمة PlayList ، ونحفظ بصيغة wpl Private Sub Make_List_2() On Error Resume Next ' 'from 'http://www.vbforums.com/showthread.php?871083-playlist-in-vb6&p=5357495&viewfull=1#post5357495 ' Dim i As Integer 'delete the file, if exists Kill Application.CurrentProject.Path & "\PlayListTest.wpl" 'Create and save a playList Open Application.CurrentProject.Path & "\PlayListTest.wpl" For Output As #1 Print #1, "<?wpl version="; 1#; "?>" Print #1, "<smil>" Print #1, " <head>" Print #1, " <title>PlaylistTest</title>" Print #1, " </head>" Print #1, " <body>" Print #1, " <seq>" For i = 0 To Me.PlayList.ListCount - 1 Print #1, " <media src=" & Chr(34) & Me.PlayList.Column(0, i) & Chr(34) & "/>" Next i Print #1, " </seq>" Print #1, " </body>" Print #1, "</smil>" Close #1 End Sub . ثم نناديه هكذا : 'do the XML playlist Call Make_List_2 With Me![wmp] .URL = Application.CurrentProject.Path & "\PlayListTest.wpl" End With . ولكنه لا يقرأ الملفات بالاحرف العربية !! فقد تستطيع ان تستعمل الكود من برنامجك الذي يحول الكلمات العربية الى chrW 🙂 جعفر 1194.Digital Player.zip
    2 points
  7. 2 points
  8. السلام عليكم اخي العزيز انظر للمرفق لو استمريت بغمل الدوال بهذه الطريقة برنامج اكسس سيظهر لك رسالة ان التركيب معقد جدا ولايقبل الاستمرار الحل : يجب اعادة ترتب الجدول من جديد تحباتي برنامج التقييم - Copy.rar
    2 points
  9. كذلك اعتذر منك ، اعطيتك امر اول حرف ، ونسيت الباقي !! [m_name] = Replace(Mid([m_name],1,1), "أ", "ا") & Mid([m_name],2) او [m_name] = Replace(left([m_name],1), "أ", "ا") & Mid([m_name],2) جعفر
    2 points
  10. جزاك الله خيرا اخى واستاذى محمد @ابا جودى بارك الله فيك جارى التحميل والتجربه وجزاهم الله خيرا جميع اخواننا واساتذتنا
    1 point
  11. السلام عليكم ورحمة الله تعالى وبركاته استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr 🌹🌹🌹 جزاكم الله تعالى كل خير وانا بفضل الله تعالى توصلت الى نتيجة ولا اروع وبدون استخدام مساعدات من خارج الاكسس دخلت لابشركم ولكن سبقتونى اسال الله تعالى ان يجعلكم سباقون بالخيرات ويتقبل منكن اعمالكم ورزقكم البركة فى العمر والعلم والاهل والولد ... اللهم امين . امين . امين وهنا نتيجة كفاحى 😄
    1 point
  12. Sub ORDER() LRW = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row With ActiveSheet.Sort .SortFields.Add Key:=Range("I2"), ORDER:=xlDescending .SetRange Range("B2:I" & LRW + 1) .Header = xlYes .Apply End With End Sub تفضل ORDER.xlsm
    1 point
  13. تفضل الإجابة في نموذج (نموذج12) استراد وتصدير.accdb
    1 point
  14. هذا لانك لم تشرح طلبك جيدا يا استاذ لم تقل ان كل مرة ترحل يضيف البيانات المرحلة في صف جديد ول هريد ان يمسح البيانات المرحلة في شيت "استدعاء وتغيير" بعد الترحيل؟ معالجة الكود.xlsm
    1 point
  15. Dim req As String req = "select * from saleh where id=3;" Me.RecordSource = req السطر الأخير معناه نجعل مصدر السجلات لنموذج الحالي هو الاستعلام req ومساهمة أخرى مع أخي @MTGFM و للمنوذج الفرعي هكذا Me.frmSub.Form.RecordSource = ("Select * From saleh")
    1 point
  16. الاستاذ سليم حاصبيا دعواتي لكم بدوام الصحة والعافية انتهت المشكلة واصبح الكود يتجاوز الخطا المذكور جعله الله سبحانه وتعالى في ميزان حسناتكم لكم وافر الاحترام والتقدير
    1 point
  17. اضف هذا السطر الوحيد(بين علاملات الـــ +) في المكان المناسب لم استطع رفع الكود من جديد لضعف النت If m=7 then MsgBox "No Data to transfer": Exit Sub
    1 point
  18. الملف قد مسحته من جهازي ارفع الملف من جديد للمعاينة
    1 point
  19. 1 point
  20. ربما يكون طلبك في المرفق تغيير بيانات العاملين في كل الشيتات مرة واحدة على اساس رقم الكود.xlsm
    1 point
  21. اين يستدعي البيانات ؟ ماهو المكان المصدر للبيانات الى صفحة التغيير علما ان كل الشيتات فيها نفس الكود100
    1 point
  22. تفضل هذا برنامج تمكين الشيفت تمكين الشفت.accdb
    1 point
  23. أهلا @Abou Hussien أعتذر إليك لعدم الرد في الوقت المناسب.. بالنسبة لتصدير البيانات فيمكنك استخدام معالج البحث في المنتدي لكون هذه الجزئية من السؤال قد سبق الإجابة عنها بطرق مختلفة.. أما ما يتعلق بتحديث وإضافة البيانات فيمكن عمل ذلك بخطوة واحدة عن طريق استعلام التحديث بالطريقة الموضحة بالشفرة أدناة.. -- بما أن كلا القاعدتين لها نفس أسماء الجداول وأسماء الحقول أيضا فنحن بحاجة إلى تمرير اسم قاعدة البيانات فقط. أعتذر عن عدم شرح الشفرة لضيق الوقت.. لكن يمكنك أن تسأل عن أي جزئية غير مفهومة! Sub UPDATE_BILL_HEAD_TBL(DATA_SOURCE As String) CurrentDb.Execute _ "UPDATE BILL AS P RIGHT JOIN [" & DATA_SOURCE & "].BILL AS F " _ & "ON (P.BILL_NUM=F.BILL_NUM) " _ & "SET P.BILL_NUM=F.BILL_NUM, P.BILL_DATE=F.BILL_DATE, " _ & "P.CLIENT_NAME=F.CLIENT_NAME, P.PAID=F.PAID, P.DETAILS=F.DETAILS" End Sub Sub UPDATE_BILL_DETAIL_TBL(DATA_SOURCE As String) CurrentDb.Execute _ "UPDATE BILL_DETAIL AS P RIGHT JOIN [" & DATA_SOURCE & "].BILL_DETAIL AS F " _ & "ON (P.BILL_NUM=F.BILL_NUM) AND (P.ITEM_NUM=F.ITEM_NUM) " _ & "SET P.BILL_NUM=F.BILL_NUM, P.ITEM_NUM=F.ITEM_NUM, P.PRICE=F.PRICE" End Sub المرفقة يوضح آلية التحديث والإضافة: Uptate Data Example.zip
    1 point
  24. وعليكم السلام 🙂 استاذ كرار ، انت لم تشرح المطلوب !! رجاء الشرح بأكبر كمية من المعلومات ، وبأمثلة 🙂 واخونا @ابوخليل كان مشارك في الموضوع السابق 🙂 جعفر
    1 point
  25. اخي الكريم حاولت فهم طلبك وسيحاول غيري ايضا ولكن لم افهم غايتك في ملفك حوالي 10 شيتات الاولى اعتقد هي الرئيسية والثانية اظن لشرح الطلب اما باقي الشيتات لا أعرف علما ان بعضها فارغ تماما ان كان ممكنا شرح ما تريد بلغة الاكسيل مع تبسيط الشرح وتقليص عدد الشيتات مثلا : الشيت كذا "" هو قاعدة البيانات الرئيسية والشيت كذا "" لاستدعاء البيانات وترحيلها حسب الشرط كذا اريد عند ادخال الكود في خلية "A2" مثلا استدعاء بيانات من شيت كذا الى شيت كذا حاول شرح طلبك مع ادخال مخرجات للبيانات في صفحة كما تريدها كمثال
    1 point
  26. اذهب إلى التقرير - افتحه في فوضع التصميم - ضع المؤشر على حقل ID - ثم اذهب إلى ورقة الخصائص للحقول - اختر أيقونة بيانات واستبدل id بـ ( 1= ) انتقل إلى مجموع تراكمي واجعله ( شامل ) كما في الصورة
    1 point
  27. السلام عليكم بعد اذن اساتذنا الكرام ممكن استخدام الداله التاليه في حاله عدم الرغبه في عمل اكواد وهذا لثراء الموضوع 11111.xlsm
    1 point
  28. اذا بكره الله سبحانه وتعالى اعطانا عمر ، فأشوف الموضوع ان شاء الله 🙂 جعفر
    1 point
  29. لم أفهم المطلوب. لكن هذه محاولة لاستخراج تاريخ آخر قسط من العمود J الى العمود AM ثم حساب المدة منذ آخر قسط. عدد الشهور المستحقة حتى الان.xls
    1 point
  30. تفضل لك ما طلبت Payroll.xlsm
    1 point
  31. هذه المعلومة غير صحيحة ، فالماكرو يحتاج كود كذلك !! تفضل 🙂 اليك طريقتين: . هلا والله بالحلوين 🙂 جعفر Disable_Command_Buttons.zip
    1 point
  32. وعليكم السلام كان يوجد لديك مشكله فالكود حيث كنت تتحقق فجدول tbluser والصحيح كما فالكود التالى DLookup("Userpassword", "tbuser", "Username = '" & txtUserID & "'") Then هذا ما تفحصته سريعا فان كان لديك مشاكل اخرى يرجى توضيحها بشرح مفصل وصور مرفقه لسرعه الاستجابه من اخوانك واساتذتنا جزاهم الله خيرا تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق SALES_AND_INVENTORY.accdb
    1 point
  33. السلام عليكم تواصل معي أخي الفاضل "وجيه شرف الدين" علي الخاص ليخبرني أن الملف به أخطاء وقد صححتها كما أرجو وأحببت أن أضيف الملف بعد التعديل حتي يستفيد منه كل من عنده نفس المسألة فقد غيرت الكود وأضفت عليه بعض الشروحات داخل الكود ليكون دليل لمن يحب التغيير أو التعديل عليه ضبط-كود-توزيع_2.xlsm
    1 point
  34. لا استطيع الاستمتاع بالتجربة يوجد مشكلة باتصال الانترنت واتابع من الجوال
    0 points
×
×
  • اضف...

Important Information