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

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

  1. Ali Mohamed Ali

    Ali Mohamed Ali

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


    • نقاط

      30

    • Posts

      11646


  2. Barna

    Barna

    الخبراء


    • نقاط

      6

    • Posts

      1081


  3. ابو جودي

    ابو جودي

    أوفيسنا


    • نقاط

      5

    • Posts

      7250


  4. محمد طاهر عرفه

    محمد طاهر عرفه

    إدارة الموقع


    • نقاط

      4

    • Posts

      8744


Popular Content

Showing content with the highest reputation on 07/10/19 in مشاركات

  1. اشكرك اخي الكريم : كلامك يحتاج حكحكة رأس ( على قول جعفر ) ..... أعطني فرصة للتفكير ....
    2 points
  2. وعليكم السلام-يمكنك تجربة ورؤية هذا الرابط https://www.officena.net/ib/topic/82235-لون-الخط-في-صندوق-الرسائل-msgbox/
    2 points
  3. تفضل عندما تريد ترتيباً تصاعدياً تقوم بكتابة رقم 1 فى الرسالة الحوارية و -1 عندما تريد ترتيباً تنازلياً الوزن.xlsm
    2 points
  4. عليك بفتح مديول جديد ووضع هذا الكود به وربطه بزر Sub xlSortSheets_Test() Dim strWhich As String Dim Which As Integer strWhich = InputBox("لترتيب أسماء الأوراق تصاعدياً أدخل الرقم 1 " & vbNewLine & "لترتيب أسماء الأوراق تنازلياً أدخل الرقم -1 ", "تحديد طبيعة ترتيب أسماء الأوراق", "1") If strWhich = vbNullString Then Exit Sub If strWhich = "-1" Or strWhich = "1" Then Which = strWhich Call xlSortSheets(Which) Exit Sub End If MsgBox "لم تدخل الأرقام المسموح بها لعمل الترتيب" & vbCrLf & "لم يتم ترتيب الأوراق", vbOKOnly End Sub Sub xlSortSheets(Optional Which As Integer = 1) Dim I As Integer Dim J As Integer Dim SheetNames() As String Dim temp As String ReDim SheetNames(Sheets.Count) For I = 1 To Sheets.Count SheetNames(I) = Sheets(I).Name Next I For I = 1 To Sheets.Count - 1 For J = I + 1 To Sheets.Count If (Which = -1 And SheetNames(I) < SheetNames(J)) _ Or _ (Which = 1 And SheetNames(I) > SheetNames(J)) Then temp = SheetNames(I) SheetNames(I) = SheetNames(J) SheetNames(J) = temp End If Next J Next I temp = Sheets(Sheets.Count).Name For I = Sheets.Count To 1 Step -1 Sheets(SheetNames(I)).Select Sheets(SheetNames(I)).Move Before:=Sheets(temp) temp = SheetNames(I) Next I Sheet1.Select End Sub
    2 points
  5. وعليكم السلام -بارك الله فيك أستاذ عبد اللطيف بالتأكيد هناك ترتيب وكما تشاء سواء تصاعدياً أو تنازلياً -كما بهذا الرابط https://www.officena.net/ib/topic/33468-هل-يمكن-ترتيب-اسماء-شيت-الاكسيل-ابجدي/ وهذا هو الملف ترتيب الأوراق حسب أسمائها.xls
    2 points
  6. اتفضل أخى الكريم ضع الكود التالى فى حدث الفورم سيظهر لك التكست بوكس 1 يحتوى على الوقت تلقائيا الكود Private Sub UserForm_Activate() Me.TextBox1 = Format(Date, "h:mm AM/PM;@") End Sub
    2 points
  7. السلام عليكم ورحمة الله وبركاته هذا برنامج صغير يتم فيه عملية تسكين موظفين او عمال ، وأصله طلب واستشارة من اخونا وحبيبنا الاستاذ محمد الحلبي هنا واحببت تخصيص عنوان جديد لهذا المشروع حيث نضب ما عندي ، ولأفسح المجال هناك للافكار الجديدة ولزيادة واستمرار المشاراكات من الاخوة الزملاء الاعضاء . ملحوظة : من فترة ليس بالقصيرة نهجت في التصميم طريقا مغايرا لطريقة اكسس الكلاسيكية وطريقة اكسس الكلاسيكية تتضح جليا في المشاريع الذي يقوم معالج اكسس بإنشائها من عيوب هذه الطريقة انها لا تلقي اي اعتبار لوقت وجهد المستخدم . آمل ان تجدوا في العمل شيئا جديدا وأفكارا نافعة dbskn.mdb
    1 point
  8. اعرض الملف كود لتحويل مصفوفة إلى عمود واحد رأسي اجتجت الي تجويل البيانات فى مصفوفات الى عمود واجد رأسي ، فقمت باعداد هذا الملف و هذا هو الكود و يجب تظليل (اختيار) المصفوفة المطلوب تحويلها لعمود قبل تشغيل الكور اختار المصفوفة ثم اضغط على الزر ملاحظة : بفضل تجميل الاصدار الاخير الذي يظهر اسفل الصفحة لانه به ميزة اضافية Sub MakeOneColumn() Dim Myrows As Integer, Mycols As Integer Myrows = Selection.Rows.Count Mycols = Selection.Columns.Count With ActiveCell For i = 0 To Mycols '6 For j = 0 To Myrows '3 .Offset(Myrows * (i) + j) = .Offset(j, i) Next j Next i End With End Sub الكود المعدل فى الاصدار التاني ، للتشغيل اختار البيانات دون رؤس الأعمدةو الصفوف Sub MakeOneColumn() Dim Myrows As Integer, Mycols As Integer Myrows = Selection.Rows.Count Mycols = Selection.Columns.Count With ActiveCell For i = 0 To Mycols - 1 For j = 0 To Myrows - 1 ' record matrix value .Offset(Myrows * (i) + Myrows + 1 + j, 1) = .Offset(j, i) ' record Row .Offset(Myrows * (i) + Myrows + 1 + j, -1) = .Offset(j, -1) ' record Col .Offset(Myrows * (i) + Myrows + 1 + j, 0) = .Offset(-1, i) Next j Next i End With End Sub صاحب الملف محمد طاهر تمت الاضافه 10 يول, 2019 الاقسام قسم الإكسيل
    1 point
  9. [level] تعيد سلسلة نصية عبارة عن اسم الشريحة في الاستعلام: قم بإنشاء عمود جديد باسم pay مثلا ثم مرر عليه الوظيفة على أن تكون قيمة المحدد الثالث (4)؛ بهذا تحصل على قيمة تمثل قيمة الرسوم والدمغات لنفس مستوى الشريحة ثم قم بوظعه بدلا عن [level]
    1 point
  10. أهلا @محمد احمد لطفى جمعت لك البيانات كلها في وضيفة واحدة وسميتها ()Cons0819 الأرقام في اسم الوظيفة يدل على الشهر والسنة للوظيفة ثلاث محددات: تاريخ الاستهلاك، وكمية الاستهلاك، ودليل البيانات الراجعة كتبت في الوظيفة تفسيرا لقيمة البيانات الراجعة قمت بوضع بعض القيمة الراجعة من الوظيفة بجوار نظيرها في الاستعلام من أجل إجراء مقارنة سريعة للتأكد صحة البيانات المهم أن الوظيفة ينقصها بعض المراجعة والضبط مع متطلباتك.. أرجو التكرم بالمراجعة.. إليك التعديل: كهرباء 2019.mdb
    1 point
  11. تم اضافة الاصدار الثاني الي نفس الموضوع فى مركز تجميل الملفات و يتضمن هذا الاصدار تسجيل اسماء الحقول لكل من العمود و الصف المناظر للخلية ايضا نقوم بتظليل المجال المطلوب تحويله فى المصفوفة (دون عناوين الصفوف و الاعمدة) كما فى الصورة ثم نشغل الماكرو
    1 point
  12. بالفعل أستاذ احمد لو حضرتك لاحظت تم دمج هذه المشاركات بالفعل من قبل هنا لأنهما نفس الطلب ونفس الموضوع
    1 point
  13. عليك السلام ورحمة الله وبركاته تم معالجة حرف ال غ في مجموع مادة الرياضيات والمجموع الكلي احصائيةالفصل 2الدراسى الأول 2019_3.xls
    1 point
  14. أستاذ العمراوي تم الإجابة على هذا الطلب في المشاركتين التي قمت بوضعهما بالأمس شاهد الصورة
    1 point
  15. السلام عليكم ورحمة الله وبركاته 🙂 في الواقع ، عرضت هذا الموضوع في منتدى الفريق العربي للبرمجة سابقا ، ولكني اعرضه هنا ، حتى تعم الفائدة ويستفيد منه الجميع. في بعض الاحيان نعمل برنامج بلغة معينة (العربية مثلاً) ، ثم لاحقا نريد هذا البرنامج لمستعملين بلغة اخرى (الانجليزية او الفرنسية مثلاً) ، مما يضطرنا ان نعمل نسخة اخرى من البرنامج 😞 اضع بين يديكم طريقة عمل برنامج بعدة لغات ، والطريقة هي الاحتفاظ بالمعلومات المطلوبة (ولا اقصد البيانات) في جدول. 1. هذه هي البيانات بلغات 3 ، العربية والانجليزية والفرنسية (والكلمات تم ترجمتها من الانجليزية الى الفرنسية عن طريق Google Translation): الخانات الموجودة بسيطة ومعرفة معناها لا يأخذ وقت ، اما تنسيق الحقل فهو:1. اسم الخط ، 2. حجم الخط ، 3. ثخانة الخط ، 4. منحني ، 5. تحته خط ، 6. لون الخط: 2. النموذج الرئيسي ، به واجهة البرنامج (والتي سنراها على الجهة اليمنى من الشرائح التالية) ، واول نموذج هو لعمل التغييرات على تنسيق الحقل ، وذلك بالنقر المزدوج في الحقل ، فتنفتح لنا نافذة اختيار الخط ، وعندما نطمئن لإختيارنا للخط ، يجب ان نحفظ هذا التنسيق ، وذللك للّغة التي نريدها: 3. اما النتائج المرجوة من البرنامج ، فتظهر لنا في هذا النموذج: باللغة العربية: باللغة الانجليزية: وباللغة الفرنسية: والكود الذي يقوم بجلب الكلمات والتنسيق هو التالي ، ولا يوجد حاجة الى تغيير الكود ، وانما العمل يكون بإضافة الخانات في الجدول: Private Sub Form_Load() On Error GoTo err_Form_Load mySQL = "Select * From tbl_Controls_Properties" mySQL = mySQL & " WHERE Form_Name='" & Me.Name & "'" mySQL = mySQL & " AND Language='" & Forms!frm_Main!Lang & "'" Dim rst As DAO.Recordset Dim x() As String Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst iTwips = 576 '576 twips/cm , 1440 twips/inch For i = 1 To rst.RecordCount Me(rst!ctl_Name).Caption = rst!ctl_Caption Me(rst!ctl_Name).Left = rst!ctl_Left * iTwips If Len(rst!ctl_Style & "") <> 0 Then x = Split(rst!ctl_Style, "|") With Me(rst!ctl_Name) .FontName = x(0) .FontSize = x(1) .FontWeight = x(2) .FontItalic = x(3) .FontUnderline = x(4) .ForeColor = x(5) If rst!Language = "A" Then '0=General '1=Left '2=Center '3=Right '4=Distribute .TextAlign = 3 Else .TextAlign = 1 End If End With End If rst.MoveNext Next i Exit Sub err_Form_Load: If Err.Number = 438 Or Err.Number = 13 Then 'ignor, Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub وهذا الكود الذي يفتح لنا msgbox : Public Function aRemark(N) 'call the Arabic Remarks in Table tbl_Controls_Properties aRemark = DLookup("[Remark]", "tbl_Controls_Properties", "[Form_Name]='" & Me.Name & _ "' And [Language]='" & Forms!frm_Main!Lang & _ "' And [Remark_ID] = " & N) End Function هذا البرنامج برنامج بدائي ، والذي يمكن تطويره 🙂 جعفر MultiLanguage2.zip
    1 point
  16. وعليكم السلام-تفضل مشكلة الحضور قبل الموعد في الاكسيل.xlsm
    1 point
  17. اعتقد الاكسيل بمختلف مستوياته سيفيدك كثيرا اما عن المحاسبة نفسها ، لا ادري ان كان دراسة المحاسبة نفسها عن طريق التعليم المفتوح مناسبا ؟ عن نفسي لم اصادف كورسات محاسبة على النت و لكن ببحث بسيط ستجد عدة كورسات على اليو تيوب و دوريات تعلن عنها شركات اضغط هنا و لكن لم اجرب اي منها
    1 point
  18. الفكرة رائعة وعبقرية لكن ممكن سؤال لو اننا نريد ان ندخل بدلا من الباسورد قيمة اخرى وزر الامر ينفذ امر اخر مثلا استعلام الحاق هل من حيلة لتمرير اى شئ الى نفس النموذج frmMSG ام اننا سوف نحتاج فى كل مرة الى نموذج خاص بالحاله التى سنتعامل معها ؟ وبذلك نكرر النموذج اكثر من مره وكل مرة باسم مختلف
    1 point
  19. صممها كما تريد على شكل نموذج .......
    1 point
  20. أحسنت استاذنا الكبير بارك الله فيك وزادك الله من فضله
    1 point
  21. الان فهمت باشمهندسنا اسف لعدم الفهم فانا في العمل واكتب في عجل وكل ساعة اكتب حرف باقي الاستفسارات ان تكرمت عن الوحدة النمطية واستيراد البرنامج
    1 point
  22. الله يرضى على عليك ويرضيك يا دكتور جننتنى شوف يا دكتور الفورم frmbeds ده لو ان السرير عطلان به اصلاح تذهب الى هذا النموذج وتقوم بالنقر المذدوج على رقم هذا السرير ليتحول الى غير متاح عندما تعود الى شاشة التسكين لن تجد هذا السرير متاح اصلا للتسكين داخل هذه الغرفة
    1 point
  23. وعليكم السلام-جرب هذا الرابط به تقريبا نفس موضوعك من أعمال الأستاذ الكبير سليم حاصبيا https://www.officena.net/ib/topic/92360-طلب-اضافة-ترحيل-بيانات-بملف-اكسل/
    1 point
  24. وعليكم السلام -يمكنك وضع واستخدام هذه المعادلة في الخلية N2 =IF(AND($O$2>=$L$2,$P$2>=$L$2),1,"")
    1 point
  25. وعليكم السلام-تفضل برنامج الأرشيف.xlsx
    1 point
  26. الف شكر يا باشا تم التطبيق بنجاح
    1 point
  27. وعليكم السلام وهذا مخزاه ان المكتبة المسئولة عن هذا التقويم غير متوفرة لديك فلابد من العمل على تنزيلها
    1 point
  28. تفضل لك ما طلبت-فانك لم توضح هذا من البداية Fuddruckers OD Jun 2019.xlsx
    1 point
  29. بالنسبة للسؤال الاول (المفروض ان فى رقم 2 التاريخ بدأ من 17-5-2015 والناتج طلع 40 المفروض يطلع 35) في رقم 2 البداية (سنة 2017) الأشهر هي 5 /6 / 7 / 8 / 9 / 10 /11 / 12 أي ما مجموعه 8 أشهر و ليس 7 بالنسبة للسؤال الثاني (المرفق صفحة Correction) تم العمل على ان 1- اذا كان تارخ البداية اكبر من 15 يحتسب نصف الشهر و الا الشهر كاملاً 2-اذا كان تاريخ النهاية اصغر من 15 يحتسب نصف الشهر و الا الشهر كاملاً كل هذا بواسطة المعادلات اما اذا اردت الحل بواسطة الماكرو تجد الحل في الصفحة vba_sh من نفس الملف المرفق الكود Option Explicit Sub get_Salary() Dim Annee%: Annee = [d1] Dim arr_val() Dim i%, ind%, t% Dim def1 As Double, def2 As Double Dim adrs1%, adrs2% Dim m As Double, s As Double Dim LRA%: LRA = Cells(Rows.Count, 1).End(3).Row Dim St_year%, End_year Dim cont%: cont = 1 Range("d2:Q" & LRA).ClearContents For i = 2 To LRA St_year = Year(Range("a" & i)) End_year = Year(Range("B" & i)) If Range("a" & i) > Range("B" & i) Then MsgBox "you an Error on range: " _ & Range("a" & i).Resize(, 2).Address & Chr(10) & _ "the start date < then end One" & Chr(10) & _ "please check your data and Rerun the Macro": Exit Sub If St_year = End_year Then ReDim arr_val(1 To 1) arr_val(1) = St_year Else For ind = 1 To End_year - St_year + 1 ReDim Preserve arr_val(1 To ind) arr_val(ind) = St_year + cont - 1 cont = cont + 1 Next End If '========================================= If UBound(arr_val) = 1 Then adrs1 = Rows(1).Find(arr_val).Column Select Case Day(Range("a" & i)) Case Is < 15: def1 = -0.5 Case Else: def1 = 0.5 End Select Select Case Day(Range("b" & i)) Case Is < 15: def2 = 0 Case Else: def2 = 1 End Select m = Month(Range("b" & i)) - Month(Range("a" & i)) + def1 + def2 - 1 Cells(i, adrs1) = Abs(m) * Range("c" & i) End If '========================================= '++++++++++++++++++++++++++++++++++++++++++++++ If UBound(arr_val) <> 1 Then adrs1 = Rows(1).Find(arr_val(1), lookat:=1).Column adrs2 = Rows(1).Find(arr_val(UBound(arr_val)), lookat:=1).Column Select Case Day(Range("a" & i)) Case Is < 15: m = 13 - Month(Range("a" & i)) Case Else: m = 13 - Month(Range("a" & i)) - 0.5 End Select Cells(i, adrs1) = m * Range("c" & i) '============================ Select Case Day(Range("b" & i)) Case Is < 15: m = Month(Range("b" & i)) - 0.5 Case Else: m = Month(Range("b" & i)) End Select Cells(i, adrs2) = m * Range("c" & i) For t = LBound(arr_val) + 1 To UBound(arr_val) - 1 adrs1 = Rows(1).Find(arr_val(t)).Column Cells(i, adrs1) = 12 * Range("c" & i) Next End If Erase arr_val: cont = 1 Next Columns("d:Q").AutoFit End Sub الملف مرفق Mounth_Price_new.xlsm
    1 point
  30. بعد اذن اخي بن علية ربما ينفع هذا الكود Option Explicit Sub cut_my_number_Please() Dim reg As Object Dim MY_match Dim Matches Dim i%, lr%: lr = Cells(Rows.Count, 1).End(3).Row Dim k%: k = 3 Dim c%: c = 1 Range("c1").CurrentRegion.ClearContents Set reg = CreateObject("VBscript.RegExp") With reg .Pattern = "1122" .Global = True End With For i = 1 To lr If reg.test(Range("a" & i)) Then Set Matches = reg.Execute(Range("a" & i)) For Each MY_match In Matches Cells(c, k) = MY_match k = k + 1 Next End If k = 3: c = c + 1 Next i End Sub الملف مرفق My_regex.xlsm
    1 point
  31. السلام عليكم ورحمة الله إذا فرضنا أن السريالات موجودة في العمود B بداية من الخلية B2 فتكون المعادلة في C2 (مثلا) كما يلي: بالفرنسية : =--STXT(B2;TROUVE("/";B2;1)-4;4) وبالإنجليزية : =--MID(B2;FIND("/";B2;1)-4;4) والله أعلم
    1 point
  32. عليك السلام ورحمة الله وبركاته بعد إذن أستاذنا الفاضل بن علية ممكن يكون الحل في الصورة المرفقة
    1 point
  33. شوف بالنسبه لمسألة التحمل لا تلقى لها بال ولا تقلق ان شاء الله طالما كنا من اهل الدنيا لن امل بخصوص النقل يمكننى ببساطة اشرح لط ما تريد نقله ولكن انا احب ان تفهم ما يدور قبل النقل لذلك تحملنى انت اما ان كنت لا تريد الفهم وتريد النقل فقط فلبيك وانا ملك يديك بكل الاحوال ان اردت الفهم ارفق ما قمت بانجازة لأرى الى اين ذخبت واين تعثرت اما ان كنت تريد النقل النقل فقط اخبرنى بالمشاركة الاتية وفورا اقول لك ببساطه تنويه ان كانت القاعدة التى ستسلمها الى العميل ما تم الهمل عليها ولا تعمل لديك فهذا فضل كبير كثير ارفقها كامله واعدل عليها واعيد ارسالها لك بعد بيعها اولا
    1 point
  34. وعليكم السلام-تفضل قيمة المبيعات 1.xlsm
    1 point
  35. اتفضل أخى الكريم تعديل بسيط على الكود الموجود بالملف يوضع فى حدث الضغط على الزر الموجود بالفورم سيقوم بفتح الملف الآخر Backup data الموجود بنفس المجلد الموجود به الملف الأول ( شرط اساسى ) وسيقوم بترحيل البيانات ثم حفظه وإغلاقه الكود Dim sh As Worksheet, ws As Worksheet Dim wkb As Workbook If TextBox1.Value = "" Or TextBox2.Value = "" Or ListBox1.Value = "" Or ListBox2.Value = "" Or ListBox3.Value = "" Or ListBox4.Value = "" Or ListBox5.Value = "" Then MsgBox "برجاء اكمال البيانات" Exit Sub End If '========================================================= Set wkb = Workbooks.Open(ThisWorkbook.Path & "\Backup data.xls") Set ws = Sheets("TAG CALL") ws.Activate '======================================================== LROW = Range("A" & Rows.Count).End(xlUp).Row Range("A" & LROW + 1).Value = TextBox2.Value Range("A" & LROW + 1).Offset(0, 1).Value = ListBox2.Value Range("A" & LROW + 1).Offset(0, 2).Value = ListBox4.Value Range("A" & LROW + 1).Offset(0, 3).Value = ListBox3.Value Range("A" & LROW + 1).Offset(0, 4).Value = ListBox5.Value Range("A" & LROW + 1).Offset(0, 5).Value = ListBox1.Value Range("A" & LROW + 1).Offset(0, 6).Value = TextBox1.Value TextBox1.Value = "" TextBox2.Value = "" ListBox1.Text = "" ListBox2.Text = "" ListBox3.Text = "" ListBox4.Text = "" ListBox5.Text = "" '--------------------------------- wkb.Close SaveChanges:=True
    1 point
  36. تفضل كان عليك من البداية استخدام خاصية البحث في المنتدى فهناك موضوع كبير للعلامة الراحل عماد الدين الحسامى يخص طلبك ,موجود على كل هذه الروابط https://www.officena.net/ib/topic/63602-أعمال-العلامه-القدير-الراحل-عماد-الدين-الحسامى/?tab=comments#comment-413052 https://www.officena.net/ib/topic/32270-لأول-مرة-في-الأكسل-شجرة-الحسابات-بهذه-الطريقة/page/2/?tab=comments#comment-260297 https://www.officena.net/ib/topic/56966-اريد-عمل-شجرة-حسابات-بالtree-view-فى-الاكسيل/?tab=comments#comment-361556 وأيضا هذا هو البرنامج شجرة الحسابات.xls
    1 point
  37. لا يمكن العمل على التخمين عليك برفع الملف وشرح المطلوب عليه بكل دقة
    1 point
  38. وعليكم السلام-تفضل فرز حسب الحالة - نقص صف.xls
    1 point
  39. تفضل لك ما طلبت ,تم التعديل للطلبات الجديدة مستحقات 1.xlsx
    1 point
  40. اتفضل كل شئ بالعربى >>---> التاريخ الميلادى - التاريخ الهجرى - الوقت دونما التقيد بلغة النظام المتغير (1).accdb
    1 point
  41. في تقديري أن هذه المقطوعة من الشفرة ناقصة! وعند مراجعتي _على عجل_ للمشاركات المتعلقة بالموضوع وجدت أنها تفتقر إلى الطريقة الصحيحة للطبيق!
    1 point
  42. بارك الله فيك أستاذ محمد وجزاك الله كل خير -توكل على الله
    1 point
  43. كود ممتاز احسنت استاذ سليم جعله الله فى ميزان حسناتك واكثر الله من أمثالك
    1 point
  44. ربما كان هذا الكود اسرع بحوالي 10 مرات باستعمال الدالتين Find & FindNext Sub search_by_salim_Method() Dim My_rg As Range Dim Find_rg As Range Dim find_What$ Dim Ro#, FiXed_Ro# Dim k#: k = 3 With Sheets("ورقة1") Set My_rg = .Range("A4").CurrentRegion.Columns(1) find_What = .Range("E1").Value .Range("E3:G1000").ClearContents End With Set Find_rg = My_rg.Find(find_What, lookat:=1) If Not Find_rg Is Nothing Then Ro = Find_rg.Row FiXed_Ro = Ro Do With Sheets("ورقة1").Range("E" & k).Resize(, 3) .Value = Sheets("ورقة1").Range("A" & Ro).Resize(, 3).Value End With k = k + 1 Set Find_rg = My_rg.FindNext(Find_rg) Ro = Find_rg.Row If Ro = FiXed_Ro Then Exit Do Loop Else MsgBox "This Item Not Exists" End If Set My_rg = Nothing: Set Find_rg = Nothing End Sub الملف مرفق الرجاء النظر الى هذه الملف لمعرفة ما أعنية من وجهة نظر السرعة Search_by_find_timer .xlsm
    1 point
  45. السلام عليكم ورحمة الله تعالى وبركاته ندخل فى الموضوع بالنسبة لربط قاعدة البينات اكسس باالاستضافات والتحكم فى البرنامج الخاص بك من اى مكان فى العالم شرط الاتصال بالانترنت اولا قمت بحجز استضافة مجانيه من هذا الموقع https://somee.com/ وقمت بانشاء جدول SQL للتجربة فقط بهذا البرنامج https://msdn.microsoft.com/en-us/sqlserver2014express.aspx?f=255&MSPPError=-2147217396 ونظرا لطلب الاخوة فى هذا الموضوع http://www.officena.net/ib/index.php?showtopic=61485&hl= بخصوص الربط وجعل قاعدة اكسس مجرد واجهة قمت باعداد هذا المرفق والذى يعتمد على الاكواد المذكورة فى المشاركة السابقة اما ان تنشء اتصال DNS وتستورد منه الجداول من خلال اكسس او تربط الجداول مباشرة بقاعدة اكسس وتضيف وتعدل فيها وقت ما تشاء ومن اى مكان تحب وعند اختيار ربط الجداول ستجد تلقائيا جدول فى قاعدة البيانات باسم mared تستطيع التعدل والاضافة فيه فى امكان اترككم مع المرفق انشاء اتصال DNS.rar
    1 point
  46. تفضل اضغط زر الأمر وانتظر قليلا لأن البيانات كثيرة Test--kemas.zip
    1 point
×
×
  • اضف...

Important Information