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

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

  1. lionheart

    lionheart

    الخبراء


    • نقاط

      8

    • Posts

      664


  2. Hamdi Edlbi-khalf

    Hamdi Edlbi-khalf

    الخبراء


    • نقاط

      6

    • Posts

      993


  3. jjafferr

    jjafferr

    أوفيسنا


    • نقاط

      6

    • Posts

      9,814


  4. أ / محمد صالح

    أ / محمد صالح

    أوفيسنا


    • نقاط

      4

    • Posts

      4,431


Popular Content

Showing content with the highest reputation on 06 فبر, 2022 in all areas

  1. وعليكم السلام اذا كنت تقصد اظهار نص مخفي بعد تمرير الماوس على نص اخر ..استعمل الكود Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.Text2.Visible = True End Sub
    2 points
  2. انا استخدم جهازين عليهما نفس الوندوز (10 / 64) احدهما عليه اكسس (2021) والثاني (2010) وكلاهما (64) والنتيجة واحدة في الجهازين على جميع الملفات واللغة في مربع النص انجليزية والاتجاه من اليسار الى اليمين والنتيجة مع المرفق الجديد نفسها لا تطابق في الألوان لكن لأول مرة فان الألوان التي تظهر في نموذج (StyleColor) هي بالضبط الألوان التي تم اختيارها من نموذج الألوان (criteriaColor) تظهر فيه كالمطلوب لكن في النص الوان أخرى استاذي الفاضل Hamdi Edlbi-khalf لا حاجة للاعتذار ولا حاجة لأن تكلف نفسك عناء حل هذه الظاهرة وانا اسميها ظاهرة ولا اسميها مشكلة لانه يمكن الالتفاف عليها ولان سببها الاكسس نفسه وحساسيته من اللغة العربية 😁 والاهم انها لم تظهر الا عند القليل من المستخدمين وعددهم الا الآن واحد وهو انا بعد أن تخلى عني الأستاذ ابو البشر 😭 ولا أظن ان الاكسس سيمزح مع الاستاذ jjafferr ليجعله ينضم معي في جماعة (نحن الوحيدون والمتميزون) 🤣 وبخصوص جعل اختيار الألوان عبر قائمة منسدلة فقد فكرت ان اقترح عليك ذلك بعد كلام الأستاذ أبو إبراهيم الغامدي ولكن لماذا نحرم الغالب الاعم من المستخدمين من الطريقة السهلة والمرنة لاختيار الألوان من اجل قلة قليلة فالحكم على الغالب الاعم وربما اذا حملت في المستقبل نسخة أخرى تنتهي المشكلة وبالنسبة لي فقد حصلت على المطلوب والحمد لله لكن قبل كلمة الختام والشكر الواجب لك وللاستاذ الفاضل أبو إبراهيم الغامدي عندي بعض الملاحظات حول تنسيق النص وجعل التلوين على مربع النص ام على مربع آخر وجعل النص في الجدول المصدر نصا عاديا وليس منسقا حفاظا عليه من التغيير ولو على سبيل الخطأ فمنذ بداية طرحي لهذا الموضوع لاحظت انه بعد عمليات القص واللصق والنسخ بين الملفات للتجربة والتلوين وعدمه والتنقل بين نص منسق ونص عادي لاحظت في بعض الأحيان تغيرا على النص الاصلي فالرموز التي يستخدمها اكسس لتنسيق النص تم ادراجها في النص ولم اهتم كثيرا لهذا الامر لان تركيزي كان على موضوع معايير التلوين واختيار الألوان لكن الان على التركيز على هذا الامر المهم وتسجيل ملاحظاتي ومحاولة معرفة متى قد يحدث هذا التغيير لاطلب رايكم ونصكحم
    2 points
  3. اضف حقل في الاستعلام مثل الصورة .... الحاق سجلات وادراج كل منهابتاريخ محدد.rar
    2 points
  4. السلام عليكم 🙂 انا طرف ثالث ، شو تريدون اجرب ؟ جعفر
    2 points
  5. In worksheet module put the following code Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 2 And (Target.Column = 5 Or Target.Column = 6) Then Application.EnableEvents = False Target.Value = Target.Value / 24 Application.EnableEvents = True Target.NumberFormat = "hh:mm" End If End Sub
    2 points
  6. لاحظت ان الكود يستعمل الامر Right ، فقد يكون هو المشكلة ، استعمل كود آخر ، او جرب : https://www.devhut.net/access-color-picker/ https://www.devhut.net/ms-access-sample-colors/ جعفر
    1 point
  7. في البداية فهمته على اساس اجابتك استاذي @jjafferr وفي الشق الثاني فهمته على اساس اظهار نص مخفي وفي الحالتين الاجابة موجودة بأذن الله
    1 point
  8. وعليكم السلام 🙂 او تلقائيا من اعدادات الحقل : . ولما تضع المؤشر على الحقل: . جعفر
    1 point
  9. في الجدول ، تأكد بأنك تستخدم نوع النص Plain Text وفي اعتقادي بأن هذه النصوص اللي تتكلم عنها ، صار لها هذا الشيء بالخطأ بسبب التجارب ، وتم حفظ هذه النتائج الى الجدول مرة اخرى. لذا يجب على المبرمج التأكد من هذه النقطة في البرمجة 🙂 بالنسبة لي ، السببين مرفوضين ، ويجب على البرنامج ان يعمل عليها جميعا ، نقطة وانتهى السطر. للعلم ، المشكلة ليست في برمجة اخي حمدي ، وانما هي في الاكواد اللي حصل عليها من الانترنت واللي تقوم بعمل تغيير قيم الالوان. جعفر
    1 point
  10. اخ حمدي ادلبي مشكور هذا هو المطلوب رفع الله قدرك
    1 point
  11. تفضل أخي .. قمت بنقل الكود لحدث عند النقر بدل عند التركيز .. ثم قمت بإضافة الشرط والرسالة ليصبح هكذا : Private Sub comm_ex_Click() On Error Resume Next Dim X As Object Dim objWord As Object Set X = CreateObject("Word.Application") Me.Refresh If Me.تدقيق7 = -1 Then 'Continue Else MsgBox "يجب التحديد للقيام بعملية التصدير", vbOKOnly, "تنبيه !" Exit Sub End If X.Documents.Open CurrentProject.Path & "\word_ex.docx" X.Visible = True X.ActiveDocument.Bookmarks("G").Select X.Selection.InsertAfter G End Sub الملف : مثال تصدير إلى ملف وورد 05-07-1443 --15-17.rar
    1 point
  12. مرحباً وسوم HTML لا تقبل RGB
    1 point
  13. أنت المحور ولست بطرف ...🙂 المشكلة تظهر عند صاحب السؤال فقط، وهي باختصار: أن اللون لا يظهر في تنسيق مربع النص، كما يظهر في color picker في التعليق السابق محاولة وقبلها محاولة أخرى نجحت مع @ابو البشر المحاولة التي نجحت مع أبي البشر
    1 point
  14. جزاك الله عني كل خير
    1 point
  15. لقد أعدت رفع المرفق ...
    1 point
  16. السلام عليكم عليك بالتلاعب بمصدر مربع السرد وليس بقيمته حتى تتمكن من ربط مربعي السرد. 2022Hamdi.accdb
    1 point
  17. جزاك الله خير عمل رائع
    1 point
  18. المشكلة التي في حاسبك أن البرنامج يعيد قلب الترتيب مع إضافة رمز الهاشتاغ وكأن المربع باللغة العربية ... أو أن جهة القراءة من اليمين إلى اليسار. ولتضح الصورة أكثر، حاول أن تكتب ضمن محرر VBA بالحروف العربية وستشاهد كيف ينقلب الترتيب بالكود ... هل حقل كود اللون مضبوط من اليسار إلى اليمين؟ هل حقل كود اللون باللغة الإنجليزية؟ ما هو إصدار الأوفيس على جهازك؟ ما هو إصدار الويندوز الذي تستخدمه؟ على أية حال ... هذا المثال بطريقة مختلفة ولم يعمل لدي بصورة سليمة فأظن أنه قد يحقق شيئاً لديك 🙃، بات من الواضح لدي أن المشكلة متعلقة بصورة أساسية بنسخ الأوفيس وإلى حد ما بخصائص حقل RichText في الأكسس.. في حال لم ينجح لديك فالحل بعمل قائمة منسدلة بأسماء الألوان ... وعندها لن يظهر اللون في نموذج ColorStyle وسيكون لزاماً تعديل النموذج حتى يعرض اللون من جديد.... أتمنى لك التوفيق ... وأعتذر مجدداً إلم يتم الأمر .... FinalcolorisingARBPROC.accdb
    1 point
  19. مرحباً الموظف المثالي.accdb
    1 point
  20. شكرا جزيلا اخوي جعفر على هذه الملاحظات الهامة والتي تعتبر عصارة خبرة طويلة مع اكسس وسوف تكون مرجعا هاما لكل من مر من هنا بالنسبة للعلاقات فرأيي ان الأخ سامي طالب علم يحسب خطواته فنتركه على سجيته يعمل ما يشاء ، فالتعلم بالبحث والاكتشاف ارسخ
    1 point
  21. السلام عليكم 🙂 اخوي ابوخليل ، الله يعطيك الصحة والعافية ، شغل جميل وخفيف 🙂 اخوي سامي ، طبعا هذه ملاحظات عامة ، واهميتها هي لتسريع عمل البرنامج ، وتجنب الاخطاء 🙂 تركت ملاحظتي سابقا والآن الى التفاصيل من واقع مرفقك في مشاركتك الاخيرة اعلاه ، وبدون ترتيب: الكود : 1. كل مكان عندك الامر Dcount ، مثل DCount("aaa","ttt") او DCount("aaa","ttt","ccc="& ddd) ، احذف aaa واستعمل النجمة * ، يعني Dcount("*","ttt") هذا يعطيك نفس النتيجة ، ولكنه اسرع ، لأنه يطلب عدد السجلات دون ان يعمل فرز لإسم الحقل وحساب عدد سجلاته. 2. كل مكان عندك الامر DCount("aaa","ttt","ccc="& ddd) ، الحقل ccc يجب ان يكون مفرس في الجدول (تسمح بالتكرار او لا ، يعتمد على دور الحقل في الجدول) ، وهذا ينطبق على الاوامر Dlookup و Dmax وووو ، فالمثال التالي ، الحقل ename يجب ان يكون مفهرس DCount("ename", "tblUsersName", "[ename]= '" & Trim(Me.ename) & "'") 3. في كل مكان في الكود ، اذا كنت ستستخدم اسم احد حقول النموذج ، فاستخدم كلمة .Me او !Me قبل الاسم ، حتى بعد سنين لما ترجع للكود ، تعرف ان هذا ليس متغير وانما هو اسم حقل. 4. في راس كل صفحة الكود استخدم السطرين Option Compare Database Option Explicit حتى تضطر ان تصرح عن المتغير المستعمل عن طريق Dim ، حتى يعمل الكود بطريقة اسرع ، وانت تعرف نوع المتغير وتعرف مكان الخطأ. 5. عند كتابة الكود ، وبين كل فترة واخرى استعمل Debug>Compile ، حتى ترى اذا كان الكود فيه اخطاء (انا عملت اختصار له في القائمة) ، انظر احد الاخطاء الموجود عندك مثلا: . 6. من الجميل عمل تنسيق الكود ، حتى تعرف من رؤيته ، بداية ونهاية الحلقات ، مثلا ، بدلا عن Private Sub cmdremove_Click() If MsgBox("هل تريد حذف السجل?", _ vbExclamation + vbOKCancel, _ "warning") = vbOK Then Me.deleteBox = True Else Exit Sub End If Me.Requery End Sub اكتب Private Sub cmdremove_Click() If MsgBox("هل تريد حذف السجل?", _ vbExclamation + vbOKCancel, _ "warning") = vbOK Then Me.deleteBox = True Else Exit Sub End If Me.Requery End Sub 7. اختصر الكلمات الطويلة ، حتى تستطيع ان تقرأها بسهولة : فبدلا عن Forms!frmdevDetails!frmDetails!userType.Enabled = False Forms!frmdevDetails!frmDetails!users.Enabled = False Forms!frmdevDetails!frmDetails!receiveDate.Enabled = False Forms!frmdevDetails!frmDetails!idOffice.Enabled = False Forms!frmdevDetails!frmDetails!dateHireEnd.Enabled = False Forms!frmdevDetails!frmDetails!returnDate.Enabled = True استخدم with Forms!frmdevDetails!frmDetails !userType.Enabled = False !users.Enabled = False !receiveDate.Enabled = False !idOffice.Enabled = False !dateHireEnd.Enabled = False !returnDate.Enabled = True end with وبدلا عن Private Sub zerClose_Click() If IsNull(Forms!frmdevDetails!frmDetails!receiveDate) And Not IsNull(Forms!frmdevDetails!frmDetails!users) Then MsgBox "لطفاً أدخل تاريخ التسليم" ElseIf Forms!frmdevDetails!frmDetails!userType = 4 And IsNull(Forms!frmdevDetails!frmDetails!dateHireEnd) Then MsgBox "لطفاً أدخل تاريخ نهايةالإعارة" ElseIf IsNull(Forms!frmdevDetails!frmDetails!userType) And Not IsNull(Forms!frmdevDetails!frmDetails!receiveDate) Then MsgBox "لطفاً أدخل نوع المستخدم" ElseIf IsNull(Forms!frmdevDetails!frmDetails!users) And Not IsNull(Forms!frmdevDetails!frmDetails!receiveDate) Then MsgBox "لطفاً أدخل المستخدم" Exit Sub Else DoCmd.Close End If End Sub استخدم Private Sub zerClose_Click() with Forms!frmdevDetails!frmDetails If IsNull(!receiveDate) And Not IsNull(!users) Then MsgBox "لطفاً أدخل تاريخ التسليم" ElseIf !userType = 4 And IsNull(!dateHireEnd) Then MsgBox "لطفاً أدخل تاريخ نهايةالإعارة" ElseIf IsNull(!userType) And Not IsNull(!receiveDate) Then MsgBox "لطفاً أدخل نوع المستخدم" ElseIf IsNull(!users) And Not IsNull(!receiveDate) Then MsgBox "لطفاً أدخل المستخدم" Exit Sub Else DoCmd.Close End If end with End sub 8. لا تستعمل الكلمات المحجوزة للأكسس في تسمية اي كائنات او متغيرات ، واذا اضطررت ان تستعملها: مثلا: لا تستعمل Me.section ، وانما استعمل Me![section] الاستعلامات : 9. كل مرة نستخدم معيار او فرز ، وفي اي مكان في البرنامج ، يجب فهرست الحقل ، مثل : . وحتى في مربع القائمة المنسدلة : . الحقل UsrType يجب ان يكون مفهرس . 10. لما تربط النموذج الرئيسي بالنموذج الفرعي ، فيجب ان يكون بينهما علاقة ، وكلا الحقلين يجب ان يكونا مفهرسين : . 11. الصور في البرنامج ، ولحفظ حجم البرنامج صغيرا ، يجب ان تكون الصور موجودة في مجلد في الكمبيوتر ، وليست في الجداول ولا مضمنه في النماذج والتقارير ، وانا استعمل المجلدات بهذه الطريقة ، فحتى لما تنقلها لكمبيوتر آخر ، كل شيء يشتغل بدون مشاكل: . وقد عملت نسخة من الصور الثلاث الموجودة في التقارير ، ووضعتها في المجلد images ، وفي التقارير ، تعمل تغيير في الاعدادات ، بدلا عن Embedded ، نعملها Linked : . حجم ملفك الاصل بعد الضغط والاصلاح: . ثم لربط الصور بالتقارير ، انظر الصور موجودة في اي قسم من التقرير ، وهنا نرى انها في رأس التقرير Report Header ، فنستخدم حدث "عند التنسيق" لهذا القسم: انقر على الخط المكتوب عليه Report Header ، ثم استعمل حدث "عند التنسيق" ، والكود سيكون : Private Sub ReportHeaderSection_Format(Cancel As Integer, FormatCount As Integer) On Error GoTo err_ReportHeaderSection_Format Me.img_Ministry_of_Education.Picture = Application.CurrentProject.Path & "\images\Ministry_of_Education.jpg" Me.img_Oman_Vision_2040.Picture = Application.CurrentProject.Path & "\images\Oman_Vision_2040.jpg" Me.img_Quality_Management_System.Picture = Application.CurrentProject.Path & "\images\Quality_Management_System.jpg" Exit_ReportHeaderSection_Format: Exit Sub err_ReportHeaderSection_Format: If Err.Number = 2220 Then 'image not found Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_ReportHeaderSection_Format End If End Sub . عليه اصبح حجم الملف ، حوالي النصف : . 12. لما تكون عندك علاقة في الاستعلام بين الجداول ، بهذه الطريقة مثلا : . ففعلا انت محتاج الى عمل علاقة بين الجداول (خارج الاستعلام) ، والتي ستجبرك على عمل فهرسة مسبقا لحقل من جانب واحد ، او عمل فهرسة للجانبين ، بمعنى: اذا عملت فهرسة لحقل في جدول واحد ، ثم عملت علاقة بين هذا الحقل A وحقل B في جدول آخر ، فيمكنك ان لا تفهرس الحقل B في الجدول ، لأن العلاقة تلقائيا تجعله مفهرسا ، والاكسس يفهم هذا. بعض الملاحظات اعلاه تقدر تقوم بها مباشرة الآن ، ولكن لا تعمل العلاقات إلا بعد ان يعطيك اخوي ابوخليل الضوء الاخضر 🙂 جعفر
    1 point
  22. اصبر علي ليوم غد سأعمل لك برنامج مبسط لمطلبك مع تسديد الديون بالحقيقة انا عملت عليه اليوم لكني لم اكمله لبعض المشاغل
    1 point
  23. Sub Test() Dim r As Long, m As Long Application.ScreenUpdating = False r = 1: m = 7 Do Cells(m, 4).Resize(, 6).Value = Application.Transpose(Cells(r, 1).Resize(6).Value) m = m + 1: r = r + 6 Loop Until r >= Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = True End Sub
    1 point
  24. In Data tab select data validation and select Custom and finally insert a formula like that =OR((A1="A"),AND(A1>=0,A1<=70)) Change the A letter with the absent character in arabic
    1 point
  25. First unprotect the worksheet Select cell B8 which is related to the scroll bar form control > Right-click the cell > Format Cells > Protection tab > Uncheck the Locked option Finally protect the worksheet again
    1 point
  26. You can directly use this line if you don't care about empty items MsgBox ListBox1.ListCount
    1 point
  27. Private Sub UserForm_Initialize() ListBox1.List = Range("A2:C11").Value End Sub Private Sub CommandButton1_Click() Dim c As Integer, i As Integer, t As Double Rem First Column In ListBox = 0 c = 0 For i = 0 To ListBox1.ListCount - 1 If ListBox1.List(i, c) <> Empty Then t = t + 1 Next i MsgBox t End Sub
    1 point
  28. جزاك الله خيرا و بارك فيك عبدللرحيم,شكرا جزيييلا على تفاعلك و ردك الجميل ذي الذوق الأصيل أنك أرفقته بملف أرسلته أنا قبل مدة,فهدا شيء رائع من قبلك,بارك الله فيك. الكود الذي أحتاجه لا يطبع إلا من الزر و فقط لا من إختصار طباعة أو غيره,و الحمد لله وجدت الحل بالتحايل و الحيلة لتجاوز كود المنع, و دونك الكود فلعل أحدا من أعضاء هذا الجمع الكريم في هذا المنتدى المميز أن يجد فيه ضالة ينشدها.و الشكر موصول للأخ المميز أبو عائشة حسونة hassona229. يوضع هذا الكود في thisworkbook Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Range("B200").Value = "" Then MsgBox "Rappel... Passez par un bouton Imprission" Cancel = True Else Cancel = False End If End Sub يوضع هذا الكود في module Sub Imprission() Dim r As Range Set r = ActiveSheet.UsedRange ActiveSheet.Range("B200").Value = "1" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TEST, openafterpublish:=True ActiveSheet.Range("af5").Value = "" With ActiveSheet.PageSetup If r.Width > 595.3 Then .Orientation = xlPortrait Else .Orientation = xlPortrait End If End With ActiveSheet.PrintOut Copies:=1 ActiveSheet.Range("B200").Value = "" End Sub
    1 point
  29. In worksheet module Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 2 And Target.Column = 20 Then Application.Goto Cells(Target.Row + 1, 2) End If End Sub
    1 point
  30. السلام عليكم ورحمة الله استخدم المعادلة التالية =COUNTIF(A1:A100;"?*")
    1 point
  31. السلام عليكم ورحمة الله فى كل كود من الاكواد الاربعة السابقة لهذا الكود استبدل تلك السطور If Sheets(2).Cells(19, 13) = "" And Sheets(2).Cells(3, 13) <> "" Then Sheets(2).Range("a1:p15").PrintOut End If بهذه السطور If Sheets(2).Cells(19, 13) = "" And Sheets(2).Cells(3, 13) <> "" Then Call InsetPics Sheets(2).Range("a1:p15").PrintOut End If
    1 point
  32. السلام عليكم ورحمة الله وبركاته أخي الكريم يمكنك ذلك بإدراج موديول ثم الحساب بالدالة CountA وفق الأسلوب التالي: تختار النطاق المطلوب من:إلى ثم تختار الخلايا المطلوب جمعها ((واستثناء الخلايا التي تحتوي معادلات والخلايا الفارغة سيتم آلياً أي أنك لست بحاجة إلى تحديد الخلايا الفارغة وخلايا المعادلات)) فتظهر النتيجة على شريط الحالة Sub FindText() 'اختيار النطاق.وتحديد خلابا مخصصة لا تحتوي على معادلات وليست فارغة Range("c14:r30").SpecialCells(xlCellTypeConstants, 23).Select 'مكان وضع نتيجة عدد الخلايا فتظهر نتيجة المعادلة مطابقة للنطاق الذي اخترته Sheets("اسم الورقة لديك").Range("Q6") = WorksheetFunction.CountA(Selection) End Sub يرجى اختيار خلية في الورقة المطلوبة يسجل فيها العدد، كما يرجى وضع شكل تطلب من خلال النقر عليه تشغيل الكود وعرض النتيجة. والسلام عليكم
    1 point
  33. للأسف نماذج الاكسل لا تدعم الارتباط التشعبي بالشكل المعتاد ولكن يمكن التحايل على ذلك بوضع عنوان الارتباط في label وتنسيق لون الخط أزرق وتحته خط وكأنه ارتباط واستعمال هذا الكود في حدث النقر على التسمية Private Sub lblLink_Click() ActiveWorkbook.FollowHyperlink Address:="mr-mas.com", NewWindow:=True Unload Me End Sub مع تغيير رابط موقعي إلى عنوان الارتباط التشعبي بالتوفيق
    1 point
  34. نسخ المعادلة من الموقع إلى الملف لا يحتاج خبرة الخطوات : * تحديد المعادلة بالضغط والسحب * كلك يمين ثم نسخ copy او الضغط ctrl+C من لوحة المفاتيح * تحديد الخلية التي تظهر فيها النتيجة * لصق المعادلة في شريط المعادلات formula bar عن طريق كلك يمين ثم لصق paste او الضغط ctrl+v من لوحة المفاتيح * الضغط على مفتاح الإدخال enter إذا ظهر خطأ فيجب تغيير الفاصلة (, ) في المعادلة إلى فاصلة منقوطة ( ; ) وأنصح بتعلم الأساسيات أولا قبل الدخول في المعادلات بالتوفيق
    1 point
  35. يمكنك استعمال هذه المعادلة =IF(OR(Q6="",F6=""),"",IF(Q6>=250,"ناجح"&IF(F6="ذكر", "", "ة"),"له"&IF(F6="ذكر", "", "ا")&" برنامج علاجي")) بالتوفيق
    1 point
  36. يمكنك استعمال هذا الكود للتصفية أولا ثم النسخ ثم الحذف Sub copy_filtered_data() If Evaluate("=COUNTIF(I:I,""جاهز"")") > 0 Then Application.ScreenUpdating = 0 Dim lr1 As Long, lr2 As Long lr1 = Sheet1.Cells(Rows.Count, 1).End(3).Row lr2 = Sheet2.Cells(Rows.Count, 1).End(3).Row + 1 Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Field:=9, Criteria1:="جاهز" Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("A" & lr2) Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).EntireRow.Delete Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Application.ScreenUpdating = 1 MsgBox "done by mr-mas.com" Else MsgBox "لا يوجد صفوف جاهزة لترحيلها" End If End Sub وهذا ملفك بعد وضع الكود وتغيير الامتداد (لأن معظم الأوقات يكون صاحب الاستفسار لا يعرف كيفية التعامل مع أساسيات الأكواد) بالتوفيق نسخ البيانات بعد الفلتر.xlsb
    1 point
  37. وعليكم السلام ورحمة الله وبركاته اولا تحية لاستاذنا العلامة عبدالله باقشير .نسأل الله ان تكون اعماله في ميزان حسناته وصدقة جاريه له ولاهله واحبابه. اخي الفاضل محاولة ربما يكون فيها طلبك الاختيار من الكمبوكس بنفس الفورم لم اتمكن من عملها ولكن قمت بعمل كمبوكس في فورم اخر تحياتي فورم ادخال و تعديل مرن بمعية فورم ادخال التاريخ.xlsm
    1 point
×
×
  • اضف...

Important Information