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

عبدالله باقشير

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

    4796
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    57

مشاركات المكتوبه بواسطه عبدالله باقشير

  1. السلام عليكم ورحمة الله وبركاته

    اعتذر اليكم اخواني عن عدم تمكني عن وضع ردوود على استفسارت الاخوة الاعضاء خلال الفترة القادمة وذلك لعدم توفر الوقت كالسابق وبسبب ضغوط العمل وسيكون وجودي حسب الممكن فارجو ان تعذروني.

    ========

    اسألكم الدعاء لي بالتوفيق

    اخوكم ابو احمد

    الله يوفقك في جميع امورك

    وانت موجود دائما معنا

    في القلب

    تقبل تحياتي وشكري

  2. السلام عليكم ورحمة الله وبركاته

    الأخ الفاضل عبدالله باقشير

    واجهتني مشكلة عند تطبيق الحل الذي تقدمت به حضرتك عندما وضعت الملفين في فولدر مشترك على جهاز وفتح أحد الملفات من جهاز آخر عن طريق الشبكة قام بفتح الملف المراد استيراد البيانات منه على الرغم من أنه مفتوح بالفعل على جهاز آخر في حين أنه في الكود دالة التحقق من ان الملف مفتوح أو مغلق

    هل من حل لهذا الموضوع

    الحل هذا معمول للاستخدام في جهاز واحد

    امور الشبكة هذه لا علم لي بها

    تقبل اعتذاري

    وتحياتي وشكري

  3. السلام عليكم

    المصفوفات
    الجداول

    تعريف مبسط : التعامل مع اكثر من قيمة واحدة

    تطبيقات عملية
    الدرس الاول :

    المصفوفات Arrays
     

    rArr = Array("A", "B", "C")

    اذا اردنا ان نضع الصفيف هذا
    على صف واحد وثلائة اعمدة

     

    Sub kh_1()
    Dim rArr
    rArr = Array("A", "B", "C")
    Range("A1").Resize(1, 3).Value = rArr
    End Sub
    

    اذا اردنا ان نضع الصفيف هذا
    على ثلاثة صفوف وعمود واحد

    تعرفون الدالة
    TRANSPOSE

    إرجاع نطاق خلايا عمودى كنطاق أفقي، أو بالعكس. يجب إدخال TRANSPOSE كصيغة صفيف في نطاق به نفس عدد الصفوف والأعمدة، على الترتيب، مثل صفيف الأعمدة والصفوف الخاصة به. استخدم TRANSPOSE لتبديل الاتجاه العمودي والأفقي لصفيف في ورقة عمل.
    بناء الجملة
    TRANSPOSE(array)
    Array (الصفيف) هو الصفيف أو نطاق الخلايا في ورقة العمل التي ترغب في تحويلها. يتم إنشاء تحويل الصفيف باستخدام الصف الأول للصفيف على أنه العمود الأول للصفيف الجديد، والصف الثاني للصفيف على أنه العمود الثاني للصفيف الجديد، وهكذا.
    ============================================================

    
    Sub kh_2()
    Dim rArr
    rArr = Array("A", "B", "C")
    rArr = WorksheetFunction.Transpose(rArr)
    Range("A1").Resize(3, 1).Value = rArr
    End Sub
    

    يتبع

    لمتابعة الموضوع افضل ان تضعوا هذه الاكواد في ملف
    الان نقوم باضافة فورم
    ونضيف التالي
    ListBox1
    CommandButton1
    CommandButton2

    اضف هذه الاكواد للفورم




    Private Sub CommandButton1_Click()
    Dim rArr
    rArr = Array("A", "B", "C")
    Me.ListBox1.List = rArr
    End Sub
    
    Private Sub CommandButton2_Click()
    Dim rArr
    rArr = Array("A", "B", "C")
    Me.ListBox1.Column = rArr
    End Sub
    
    Private Sub UserForm_Initialize()
    Me.ListBox1.ColumnCount = 3
    End Sub
    

    بعد فتح الفورم

    اضغط على الازرار

    CommandButton1
    CommandButton2

    ما هي النتيجة

    يتبع
    =============================================================
    المصفوفة

    Array("A", "B", "C")

    من النوع Variant
    وذو البعد الواحد
    واول دليل لعناصرها LBound
    صفر
    وآخر دليل لعناصرها UBound
    عدد عناصرها ناقص واحد
    ونضيف عناصرها دفعة واحدة
    =============================================================

    بعض الدالات للسلاسل النصية تعطي نتائج صفيف
    مثل SPLIT
    FILTER

    ناخذ مثال عن SPLIT

     

    Sub kh_Split()
    Dim MyAr
    MyAr = Split("عبدالله علي احمد باقشير")
    Range("A1").Resize(1, UBound(MyAr) + 1).Value = MyAr
    End Sub

    ===========================================================
    ===========================================================
    ===========================================================
    الدرس الثاني :

    الجداول المفهرسة


    عبارة عن متغيرات مفهرسة Indexed Variables تحتوي على بيانات عديدة من نفس النوع Data Type .
    كل مصفوفة لها اسم واحد يمكن استخدامه للرجوع إلى أي عنصر فيها وذلك باقتران هذا الاسم بدليل يمثل مكان العنصر فيها ، ويمكن انشاء مصفوفة لإحتواء أي نوع من أنواع البيانات مثل : النصوص والأعداد الحقيقية و الصحيحة وغيرها ، فأنواع البيانات المتوفرة في الفيجيوال بيسك هي :

    Data Type in VB: {Byte, Boolean, Integer, Long, Single, Double, Currency, Decimal, Date, Object, String, Variant, User-defined }.


    واستخدام المصفوفات في البرمجة يساعد في صناعة أكواد قصيرة وبسيطة ذات قوة كبيرة لأنه يمكن بناء Loops تتعامل بكفاءة مع المصفوفات مهما كان عدد عناصرها وذلك باستخدام دليل العنصر Index Number .

    =================================================

    الخصائص الأساسية للمصفوفة في الفيجيوال بيسك :

    اسم المصفوفة يمثل عنوان Address في الذاكرة ؛ ولا يمكن تغييره أثناء تنفيذ البرنامج .
    يمكن الإعلان عن مصفوفة لأي نوع من أنواع البيانات بما في ذلك الأنواع المعرفة من قبل المستخدم User-defined type والـ Object Variables .
    كل وحدة بيانات منفردة في المصفوفة تسمى عنصر Element .
    جميع العناصر تكون من نفس النوع إلا في حالة الإعلان عن المصفوفة كـ Variant Data Type .
    جميع العناصر تكون مخزنة على التتابع في ذاكرة الحاسوب ودليل أول عنصر هو الصفر كـ Default
    ويمكن جعله 1
    باستخدام جملة في بداية الوحدة النمطية

    Option Base 1

    لكل مصفوفة حداً أعلى Upper bound ، وحداً أدنى Lower bound ؛ وعناصر المصفوفة تكون محصورة بين هذين الحدين .
    من الممكن أن تكون المصفوفة ذات بعد واحد أو متعددة الأبعاد .


    تحديد الحدين الأعلى والأدنى للمصفوفة Upper bound & Lower bound:
    عند الإعلان عن مصفوفة، يكتب الحد الأعلى بعد الاسم وبين الأقواس.
    لا يمكن أن يزيد الحد الأعلى عن نطاق نوع المتغير Long Data Type.
    الحد الأدنى الإفتراضي Default هو الصفر.

    اذا عرفت عن هذا المتحول بـــــ
    Limiteinf To LimiteSup
    في مكان الوسيط Indexs
    تكون قد عرفت جدولا بعدد عناصر محدد وبارقام دليل محددة

    وهذه الطريقة افضل للاستخدام للفهم السريع للوسيط Indexs

    Dim ay(1 To 3, 1 To 2) As String

    -----------------------------------------------------------------------------
    ay(1 To 3, 1 To 2)

    لمعرفة الدليل الاول والاخير لليعد الملون بالاحمر للمتحول
     

    LBound(ay, 1)
    UBound(ay, 1)

    لمعرفة الدليل الاول والاخير للبعد الملون بالازرق للمتحول
     

    LBound(ay, 2)
    UBound(ay, 2)

    ==================================================================
    ==================================================================
    ملحوظة
    عند إضافة أبعاد المصفوفة فإن مساحة التخزين المطلوبة سوف تزيد زيادة كبيرة ولذلك ينبغي الاحتراس
    وتفادي استخدام النوع Variant قدر الإمكان لما يتطلبه من مساحة تخزينية كبيرة!

    ==================================================================
    ==================================================================

    المصفوفة ذات الحجم الثابت
    نعلن عنها بأحد أوامر الإعلان (Public or Private or Dim or Static)
    مع تحديد عدد العناصر في الأقواس



    Dim ay(1 To 3, 1 To 2) As String

    مثال 1:
     

    
    
    Sub kh_Array1()
    Dim ay(1 To 3, 1 To 2) As String
    ay(1, 1) = "A"
    ay(2, 1) = "B"
    ay(3, 1) = "C"
    ay(1, 2) = "D"
    ay(2, 2) = "E"
    ay(3, 2) = "F"
    Range("A1").Resize(3, 2).Value = ay
    End Sub
    
    

    مثال 2
    جدول ضرب

     

    Sub KH_5()
    Dim sArr(1 To 12, 1 To 10) As Integer
    Dim ContRow As Integer, ContColmn As Integer
    Dim c As Integer, r As Integer
    
    ContRow = UBound(sArr, 1)
    ContColmn = UBound(sArr, 2)
    
    For r = 1 To ContRow
    For c = 1 To ContColmn
    sArr(r, c) = r * c
    Next
    Next
    Range("A1").Resize(ContRow, ContColmn).Value = sArr
    End Sub
    

    المصفوفات متغيرة الحجم Dynamic Array:


    في بعض الأحيان، لا نعرف مسبقاً حجم المصفوفة التي سنستخدمها في البرنامج بالضبط، وقد نريد تغيير حجم المصفوفة أثناء تشغيل البرنامج، هنا سنحتاج إلى المصفوفات ذات الحجم المتغير Dynamic حيث يمكننا تغيير حجمها في أي وقت.
    تعتبر المصفوفات متغيرة الحجم أحد مميزات الفيجيوال بيسك، وهي تساعد في تنظيم الذاكرة بكفاءة. فمثلاً، يمكن استخدام مصفوفة كبيرة لوقت قصير ثم إعادة تحجيمها لتحرير مساحة من الذاكرة عندما لا نحتاجها. وهذا من شأنه تسريع المعالجة.


    ولصناعة Dynamic Array نتبع التالي:

    نعلن عنها بأحد أوامر الإعلان (Public or Private or Dim or Static) ونجعلها ديناميكية بعدم كتابة أي رقم في الأقواس كما يوضح المثال التالي:



    Dim sArr() As String

    نعيد الإعلان عنها مع تحديد عدد العناصر باستخدام جملة ReDim كما في المثال التالي:
     

    ReDim sArr(1 To ContRow, 1 To ContColmn)

    ==================================================================
    ==================================================================
    ملاحظات هامة
    . كل جملة من جمل ReDim يمكنها تغيير عدد العناصر بالإضافة إلى الحد الأعلى والحد الأدنى لكل بعد للمصفوفة،
    ومع ذلك فإن عدد الأبعاد في المصفوفة لا يمكن تغييره.
    . تمحى جميع القيم المخزنة في المصفوفة كل مرة يعاد فيها تنفيذ جملة ReDim. ويجعل الفيجيوال بيسك القيم كالتالي:

    في حالة الــــ Variant Array --------- الى ----- Empty Value
    في حالة الــــ Numeric Array ------- الى ----- Zero
    في حالة الــــ String Array ----------- الى ----- Zero-Length String
    في حالة الــــ Array of objects ------ الى ----- Nothing

    وهذا مفيد عندما نريد تجهيز المصفوفة لبيانات جديدة أو عندما نريد اختزال حجم المصفوفة لتأخذ أقل مساحة ممكنة في الذاكرة.

    ==================================================================
    ==================================================================
    مثال 1:




    
    Sub KH_6()
    Dim sArr() As String
    Dim iName As String
    Dim ContRow As Integer, ContColmn As Integer
    Dim c As Integer, r As Integer, i As Integer
    
    Range("H7").Resize(14, 5).ClearContents
    iName = CStr([H4])
    ContColmn = 5
    With Range("B7").Resize(14, 1)
    ContRow = WorksheetFunction.CountIf(.Cells, iName)
    ReDim sArr(1 To ContRow, 1 To ContColmn)
    For r = 1 To .Rows.Count
    If CStr(.Cells(r, 1)) = iName Then
    i = i + 1
    For c = 1 To ContColmn
    sArr(i, c) = CStr(.Cells(r, c))
    Next
    End If
    Next
    End With
    Range("H7").Resize(ContRow, ContColmn).Value = sArr
    Erase sArr
    End Sub
    
    
    

    دروس المصفوفة 1.rar

    ==================================================================
    ==================================================================
    Erase

    تستخدم لتحرير الذاكرة المعينة للجداول الديناميكية واعادة تعيين عناصر الجدول الى قيمتها البدائية بطول ثابت
    مثال:

    Erase sArr

    ==================================================================
    ==================================================================


    تغيير حجم المصفوفة دون فقد بياناتها
    يمكننا فعل ذلك باستخدام جملة ReDim مع كلمة Preserve
    وتعني الحفظ


    الجملة التالية تغير حجم المصفوفة ولكنها لا تمحو العناصر الموجودة بها:
     

    ReDim Preserve MyArray( 10 )

    والآن يمكننا كتابة ملخص متكامل لجملة ReDim.

    جملة ReDim:

    تستخدم في مستوى الـProcedure لإعادة تخصيص allocates مساحة تخزينية storage space لمصفوفة متغيرة الحجم Dynamic array.

    صيغتها Syntax:
     

    ReDim [Preserve] varname(subscripts) [As type] [, varname (subscripts) [As type]]

    ==================================================================
    ==================================================================

    ملاحظات هامة:

    جميع ما ذكر في الصيغة داخل قوسين مربعين [] يعتبر اختياري يمكن الاستغناء عنه حين عدم الحاجة إليه.
    تستخدم جملة ReDim لتحجيم أو إعادة تحجيم مصفوفة متغيرة الحجم Dynamic Array والتي بالفعل قد أعلن عنها مسبقاً باستخدام أي من الجمل Dim, Private, Public مع أقواس فارغة (أي بدون ذكر الأبعاد).
    يمكن تكرار استخدام جملة ReDim لتغيير عدد العناصر والأبعاد لمصفوفة، ومع ذلك لا يمكن الإعلان عن مصفوفة بنوع معين من البيانات ثم إعادة تعريفها لاحقاً مع تغيير نوع البيان لنوع آخر إلا إذا كانت المصفوفة محتواه في variant.
    إذا كانت المصفوفة محتواه في variant فإن نوع بيان العناصر يمكن أن يتغير باستخدام المقطع As Type إلا إذا استخدمنا كلمة Preserve ففي هذه الحالة لا يسمح بتغييرات.
    إذا استخدمنا كلمة Preserve يمكن فقط تحجيم البعد الأخير للمصفوفة ولا يمكن تغيير عدد الأبعاد على الإطلاق.
    إذا كان للمصفوفة بعد واحد فيمكن إعادة تحجيم هذا البعد لأنه البعد الأخير والوحيد بالمصفوفة.
    وإذا كان للمصفوفة بعدين أو أكثر فيمكن فقط تغيير حجم البعد الأخير مع الاحتفاظ بمحتويات المصفوفة.
    عندما نستخدم Preserve يمكن تغيير حجم المصفوفة بتغيير الحد الأعلى بينما ينتج لدينا خطأ حين تغيير الحد الأدنى.
    إذا صنعنا مصفوفة أصغر مما كانت فإن بيانات العناصر المخزنة سوف تفقد.


    تحذير:

    جملة ReDim ستعمل وكأنها جملة إعلان إذا كان المتغير (المصفوفة) التي تعلن عنه غير موجود على مستوى الـProcedure أو الـModule. وإذا كان هناك متغير آخر بنفس الاسم قد أنشئ بعد ذلك وحتى لو كان في النطاق ككل Scope؛ فإن ReDim سوف ترجع للمتغير الأخير ولن يتسبب عن ذلك خطأ في الترجمة Compilation error حتى ولو كانت جملة Option Explicit فعّالة. وبذلك لن يدرك المبرمج أنه هناك خطأ بالشيفرة code.
    ولتفادي هذا التعارض لا ينبغي استخدام جملة ReDim كجملة إعلان بدلاً من Dim مثلاً، ولكن نستخدمها فقط لإعادة تعريف حجم المصفوفة.

    ==================================================================
    ==================================================================
    توضيح اكثر لهذه الملاحظة
    إذا استخدمنا كلمة Preserve يمكن فقط تحجيم البعد الأخير للمصفوفة ولا يمكن تغيير عدد الأبعاد على الإطلاق.

    امثلة : للبعد الاخير ( الملون بالاحمر)

    هنا ثلاثة ابعاد
    البعد الاخير هو 15
    ReDim Preserve X(10,12,15)


    ReDim Preserve X(10,12,15)

    هنا بعدين
    البعد الاخير هو 12
    ReDim Preserve X(10,12)

    ReDim Preserve X(10,12)

    هنا بعد واحد
    إذا كان للمصفوفة بعد واحد فيمكن إعادة تحجيم هذا البعد لأنه البعد الأخير والوحيد بالمصفوفة
    ReDim Preserve X(10)

    ReDim Preserve X(10)

    حمل الملف الموجود في هذا الموضوع تطبيق عملي لما ذكر اعلاه
    http://www.officena....showtopic=42346

    http://www.officena.net/ib/index.php?showtopic=42584

    دروس المصفوفة 1.rar
    kh_SumProduct.rar
    دروس المصفوفة ( دالة لتوليد ارقام عشوائية).rar

     

    ((الشرح العلمي منقول من هنا وهناك))
    تم بحمد الله وشكره

    • Like 9
    • Thanks 1
  4. السلام عليكم

    انسخ الكود هذا وحطه بين اكواد الفورم

    
    
    
    Private Sub TextBox35_Change()
    
    Dim Tgdeer As String
    
    Select Case Val(Me.TextBox35)
    
    Case 90.0001 To 100: Tgdeer = "مـمـــــتــــــاز"
    
    Case 80.0001 To 90: Tgdeer = "جــيـــد جـــــداً"
    
    Case 70.0001 To 80: Tgdeer = "جـــــــيـــــــد"
    
    Case 50.0001 To 70: Tgdeer = "مـــرضـــــــي"
    
    Case Else: Tgdeer = "غير مرضي"
    
    End Select
    
    Me.TextBox36.Text = Tgdeer
    
    End Sub
    
    
    
    

    ودمتم في حفظ الله

  5. السلام عليكم ورحمة والله وبركاته

    أخوي الاستاذ عبدالله باقشير

    لا أقول إلا أن شهادتنا فيك مجروحة

    هل يمكن عندما نضع الكود ثم نضع الكود المطلوب

    أن

    يظهر بالبحث فقط االرقم نفسه وليس كل ما يحتوي هذا الرقم

    المطلوب فقط بالكود

    وجزيت خير الجزاء

    حفظك الله

    غير السطر هذا في كود البحث

    ib = InStr(1, .Cells(R, MyColmnFind), Me.TextFind, vbTextCompare) = 1
    بهذا السطر
    ib = UCase(.Cells(R, MyColmnFind)) = UCase(Me.TextFind)

    تقبل تحياتي وشكري

  6. السلام عليكم

    هل ترغب في استيرادها بزر

    في الملف 2

    اذا اردتها عند فتح الملف 2

    استخدم الكود التالي في حدث ThisWorkbook

    
    Private Sub Workbook_Open()
    
    Call kh_DateImport
    
    End Sub
    
    
    وهذا هو الكود :
    
    Sub kh_DateImport()
    
    Dim ib As Boolean
    
    Dim MyAr
    
    Dim MySh As Worksheet
    
    Dim MyNBook As String, MyPath As String, rAd As String
    
    
    On Error GoTo 1
    
    
    Set MySh = ThisWorkbook.Sheets("Statment")
    
    MySh.UsedRange.ClearContents
    
    MyNBook = "ملف 1" & ".xls"
    
    MyPath = ActiveWorkbook.Path & "\" & MyNBook
    
    '---------------------------------------
    
    ' هل الملف مغلق
    
    ib = Not Workbook_Open(MyNBook)
    
    '---------------------------------------
    
    Application.ScreenUpdating = False
    
    ' اذا الملف مغلق يقوم بفتحه
    
    If ib Then Workbooks.Open MyPath
    
    '---------------------------------------
    
    With Workbooks(MyNBook).Sheets("Statment")
    
    rAd = .Cells.CurrentRegion.Address
    
    MyAr = .Range(rAd).Value
    
    End With
    
    '---------------------------------------
    
    ' اذا كان الملف مغلق سابقا يقوم باغلاقه
    
    If ib Then Windows(MyNBook).Close
    
    '---------------------------------------
    
    MySh.Range(rAd).Value = MyAr
    
    Application.ScreenUpdating = True
    
    MsgBox "تم الاستيراد بنجاح"
    
    
    1:
    
    If Err Then
    
    MsgBox "Err.Number : " & Err.Number
    
    Err.Clear
    
    End If
    
    
    MyAr = Empty
    
    Set MySh = Nothing
    
    End Sub
    
    
    'دالة لمعرفة ان كان الملف مفتوخ
    
    
    Function Workbook_Open(WbookName As String) As Boolean
    
    Dim wBookCheck As Workbook
    
    Application.Volatile
    
    On Error Resume Next
    
    Set wBookCheck = Workbooks(WbookName)
    
    Workbook_Open = Not wBookCheck Is Nothing
    
    On Error GoTo 0
    
    End Function
    
    

    شاهد المرفق

    Data1-2.rar

    • Like 1
  7. في الملف المرفق

    فورم بحث عند البحث تظهر تكستات بوكس بكل بيانات الصف

    آخر تكست خاص ( بالجنسية ) وعند التعديل في اي تكست بوكس يتم التعديل في الخليه فورا

    المطلوب

    ان يستبدل التكست بوكس والخاص بالجنسية عند الظهور بعد البحث بكمبوبكس يكون فيه خياران ( تم الصرف ، لم يتم الصرف )

    كي يمكنني العمل عليه لبرنامجي

    Listbox Form5.rar

    تم التعديل اضافة الاسطر هنا

    قارن بين السابق وهذا

    
    
    Private Sub kh_Add_Controls(MyCont As Control, MyTop As Integer, iRo As Integer, MyCount As Integer)
    
    'On Error Resume Next
    
    Dim MyTxt As Control
    
    Dim MyTyp As String
    
    Dim i As Integer
    
    For i = 1 To MyCount
    
        If i = MyCount Then MyTyp = "Forms.ComboBox.1" Else MyTyp = "Forms.TextBox.1"
    
        Set MyTxt = MyCont.Add(MyTyp, Cells(iRo, i).Address, True)
    
        With MyTxt
    
            .Move MyCont.Controls(i - 1).Left, MyTop, MyCont.Controls(i - 1).Width, MyHeight
    
            .AutoTab = True
    
            If i = MyCount Then
    
                .List = Array("تم الصرف", "لم يتم الصرف")
    
            Else
    
                .MultiLine = True
    
                .ScrollBars = 3
    
            End If
    
            .TextAlign = 3
    
            .Font.Bold = True
    
            .Font.Size = 12
    
            .FontName = "Times New Roman"
    
            '===========================================
    
            .ControlSource = "'" & Mysh_Name & "'!" & Range(.Name).Address
    
            '===========================================
    
        End With
    
    Next i
    
    
    '==================
    
    Set MyTxt = Nothing
    
    '==================
    
    'On Error GoTo 0
    
    End Sub

    المرفق 2003

    Listbox Form5.rar

  8. السلام عليكم أستاذي عبدالله باقشير

    إذا أردت أن نسخ نتيجة البحث في نفس الملف ولكن في شيت رقم 3 ابتداء من الخلية A6

    فكيف يكون التعديل في الكود ؟

    تفضل استبدل بهذا

    
    Private Sub ButtonSaveFil_Click()
    
    Dim iC As Integer
    
    iC = Me.ListFind.ListCount
    
    If iC = 0 Then GoTo 1
    
    '------------------------
    
    Application.ScreenUpdating = False
    
        With Sheets(3)
    
            .Select
    
            .Range("A6").Resize(iC, ContColmn).Value = Me.ListFind.List
    
        End With
    
    Application.ScreenUpdating = True
    
    Unload Me
    
    1
    
    End Sub

    • Like 1
  9. السلام عليكم

    اخي الفاضل / ابو ردينه ------------------حفظه الله

    كل شي داخل الملف بميزان

    ويجب ان تراعي هذه الامور حسب الحجم المعقول لملفك

    وتستغني عن الاشياء التي مش حتقدم ولا تاخر

    مثلا الصور - التنسيقات بانواعها الا الضروري منها

    المعادلات التي تاخذ مدى طويل بدون داعي

    يجب ان تقتصر على المدى الفعلي

    وهكذا وقيس على ذلك الاكواد بمثل المعادلات

    بمعنى آخر اذا اتقنت العمل مع المعادلات

    تاكد انك حتتقن الاكواد

    وانا انصح ان لا يبدى العمل بالاكواد

    حتى يتقن التعامل مع المعادلات

    فهمك لدوال المعادلات

    واستخدام المراجع النسبية والمطلقة في المعادلات

    انطلاقة ممتازة

    للتعامل مع الاكواد

    اما هذا

    هل هناك من حالات لابد فيها من وجود الماكرو مع الكود و لماذا ؟

    أو بصيغة أخرى

    هل يمكن الأستغناء عن وجود الماكرو بكتابة ما ينفذه كأحد الأوامر البرمجية ضمن الكود أم لا و لماذا ؟

    اعذرني لم افهم منه شيئا

    تقبل تحياتي وشكري

  10. ما شاء الله ،،

    تبارك الباري ،،

    عمل جبار ،،

    وسلكت الأيادي ،،

    أستاذنا : ياريت تشرح لينا الطريقة ونكون لك من الشاكرين والداعين لك بالخير ..

    موفقين .

    شاهد الموضوع في الرابط ادناه

    وحتعرف الكثير

    http://www.officena.net/ib/index.php?showtopic=42261&st=0

  11. السلام عليكم ورحمة الله وبركاته

    احبتي في الله

    الاخ الفاضل / رجب جاويش__________ حفظه الله

    الاخ الفاضل / ياسر الحافظ__________ حفظه الله

    الاخ الفاضل / دغيدي__________ حفظه الله

    الاخ الفاضل / amfouad555__________ حفظه الله

    الاخ الفاضل / الانيس__________ حفظه الله

    الاخ الفاضل / الشهابي__________ حفظه الله

    الاخ الفاضل / ubd__________ حفظه الله

    الاخ الفاضل / عبدالله المجرب__________ حفظه الله

    الاخ الفاضل / ناصر سعيد__________ حفظه الله

    الاخ الفاضل / ابو الحسن__________ حفظه الله

    الاخ الفاضل / ابو ردينة__________ حفظه الله

    الاخ الفاضل / mahmoud-lee__________ حفظه الله

    الاخ الفاضل / عباس السماوي__________ حفظه الله

    الاخ الفاضل / الجزيرة__________ حفظه الله

    الاخ الفاضل / khhanna__________ حفظه الله

    الاخ الفاضل / ابو انصار__________ حفظه الله

    الاخ الفاضل / fidodido__________ حفظه الله

    الاخ الفاضل / apt__________ حفظه الله

    شرفتموني بحضوركم الغالي

    اكرمكم الله في الدارين

    وجزاكم خيرا وبارك فيكم

    واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة

    ودمتم في حفظ الله

  12. السلام عليكم

    جمعة مباركة

    فورم بحث جميل وبامكانيات مرنة (وسنتعلم منه الكثير)

    هو طلب لاحدهم ولكني جعلته هنا

    لانه مهم للكثير

    الموضوع في الرابط ادناه

    http://www.officena....opic=42261&st=0

    المرفق 2003-2007

    ملف بحث بفورم ممتاز.rar

    • Like 4
    • Thanks 1
  13. بسم الله

    نعم .....نعم اخي واستاذنا الكبير عبد الله باقشير هو المطلوب

    جزاك الله كل الخير

    ولي طلب آخر : ارجو ان كان ممكنا ان يكون التحليل لثلاث حسابات للاعلى فقط ( كاقصى حد ) والحساب المطلوب هو الرابع .

    وارجو ان يكون نفس العمل في العمود /L/

    تشكر بكل الاحوال استفدت كثيرا من ردك

    في المرفق ملف سند القيد بعد التعديل على نحو ما ورد بمشاركتك رقم / 3 /

    وفقك الله

    ابو الحارث

    حفظك الله

    جرب الكود التالي

    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Num$, i%
    
    On Error Resume Next
    
    If Not Intersect(Target.Cells, Range("F12:F25,L12:L25").Cells) Is Nothing Then
    
    Num = Trim(Target)
    
    If Not IsNumeric(Num) Then Exit Sub
    
    Application.EnableEvents = False
    
    For i = 1 To 3
    
    If Len(Num) - i Then
    
    If Target.Offset(-i, 0).Row = 10 Then GoTo 1
    
    Target.Offset(-i, 0).Value = Mid(Num, 1, Len(Num) - i)
    
    End If
    
    Next
    
    1:
    
    Application.EnableEvents = True
    
    End If
    
    End Sub
    
    

    شاهد المرفق2003

    سند قيد 2.rar

  14. السلام عليكم

    انصح باستخدام الدالة kh_Test_MyChr

    عند اعادة تسمية شيت

    لمعرفة اخطاء التسمية ان وجدت

    المرفق 2003و 2007

    
    Sub kh_CopySheet()
    
    Dim MyName As String
    
    MyName = [F2]
    
    If kh_Test_MyChr(MyName) = True Then Exit Sub
    
    Sheets("sheet1").Copy After:=Sheets(Sheets.Count)
    
    Cells.Worksheet.Name = MyName
    
    End Sub
    
    '===============================================
    
    Function kh_Test_MyChr(KhString As Variant) As Boolean
    
    Dim MySh As Worksheet
    
    Dim MyChArray, MyChr
    
    Dim S As Integer, R As Integer
    
    S = Len(Trim(KhString))
    
    If S > 31 Or S = 0 Then
    
    MsgBox "حروف الاسم قد تكون اصغر من 1 او اكبر من 31", 524288 + 1048576 + 16, "اسم مرفوض"
    
    kh_Test_MyChr = True
    
    Exit Function
    
    End If
    
    '------------------------------------
    
    MyChArray = Array("/", "*", ":", "؟", "?", "[", "]")
    
    For Each MyChr In MyChArray
    
    If InStr(1, KhString, MyChr, 1) <> 0 Then
    
    MsgBox "حروف الاسم تحتوي على الحرف " & Chr(10) & Chr(10) & Chr(9) & MyChr & Chr(10) & Chr(10) & "وهو من الاحرف الممنوعة " & "/ * : ؟ [ ]", 524288 + 1048576 + 16, "حرف ممنوع"
    
    kh_Test_MyChr = True
    
    Exit Function
    
    End If
    
    Next
    
    '------------------------------------
    
    For Each MySh In ActiveWorkbook.Sheets
    
    If UCase(Trim(MySh.Name)) = UCase(Trim(KhString)) Then
    
    MsgBox "الاسم مكرر ", 524288 + 1048576 + 16, "اسم مكرر"
    
    kh_Test_MyChr = True
    
    Exit Function
    
    End If
    
    Next
    
    End Function
    
    

    جديد.rar

  15. السلام عليكم

    اخي الفاضل انت اوجزت الشرح وحصرت المشكلة

    ان الكود الذي في الاعلى استخدمة في كثرة يعني قد يصل الى اكثر من 15 مرة

    ان كانت مشكلتك هذه

    اذن

    مثل ما عرفت المتغير يمكن تنهي ربطه

    بالكود التالي:

    set sh =Nothing

    ان شاء الله يكون تشخيصك صح

    لان هذا العلاج

    ودمتم في حفظ الله

  16. السلام عليكم

    جرب الكود هذا لعله المطلوب

    مع ملاحظة ضع الكود في حدث الورقة

    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Num$
    
    On Error Resume Next
    
    If Not Intersect(Target.Cells, Range("F12:F25").Cells) Is Nothing Then
    
        Num = Trim(Target)
    
        If Not IsNumeric(Num) Then Exit Sub
    
        If Len(Num) - 1 Then
    
            Target.Offset(-1, 0).Value = Mid(Num, 1, Len(Num) - 1)
    
        End If
    
    End If
    
    End Sub
    
    

    ودمتم في حفظ الله

×
×
  • اضف...

Important Information