اكواد الترحيل والاستدعاءات .. المرجع

**ناصر سعيد** · نوفمبر 18, 2017

بسم الله الرحمن الرحيم

احبابنا في الله

ادعو الله ان تكونوا بخير وبعد :

هذا ملف به اكواد جمعتها وهذبتها

لتكون مرجعا لمن اراد كودا من اكواد الترحيل او الاستدعاءات

*** ففيه كود استدعاء بيانات صفحه لصفحه اخرى بشرط
والشرط موجود في الخليه C1 في هذه الصفحه

===

*** وفيه كود استدعاء اعمده معينه بدون شرط

====

وفيه كود استدعاء اعمده معينه بشرط داخل الكود

===

وفيه كود استدعاء اعمده معينه بشرطين من خارج الكود

===

وفيه كود استدعاء بيانات اعمده معينه بشرطين موجودين داخل الكود

وكل كود في صفحه واسطره مشروحه

حتى يسهل فهمها وتطويعها لملفاتكم

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

إدعوا لكل من كانت له بصمه في هذا العمل بالخير

المرجع في الاستدعاءات والترحيل.rar

**ناصر سعيد** · نوفمبر 18, 2017

لو اراد احد الاخوه الكرام ان يضيف كودا اخر

لاثراء الموضوع فنكون شاكرين فضله

**ناصر سعيد** · نوفمبر 18, 2017

'================
Sub Trans_Data()

'الكود خاص بالمحترم زيزو العجوز
'يحفظه الله
'تم هذا الكود في 15/11/2017
'الهدف من الكود هو استدعاء صفحة كامله بشرط
'================
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'الاعلان عن اسماء الشيتات'
Dim Main As Worksheet, sh As Worksheet

'  الاعلان عن المصفوفتين
Dim Arr As Variant, Temp As Variant

'(i,j)الاعلان عن ابعاد المصفوفة الاولى ( p  ) وعداد المصفوفة الثانية
Dim i As Long, j As Long, p As Long

' الاعلان عن المتغير الذى سوف يتم العمل عليه
Dim dep As String

Set Main = Sheets("المصدر")
Set sh = Sheets("الهدف")
'=======
'  محو البانات القديمة
sh.Range("A7:AC" & Main.Range("B" & Rows.Count).End(xlUp).Row).ClearContents

'    معيار الاختيار
dep = sh.Range("C1").Value

 '     المصفوفة المصدر
Arr = Main.Range("A7:AC" & Main.Range("B" & Rows.Count).End(xlUp).Row).Value

'     ابعاد المصفوفة الهدف
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))

 '     طول المصفوفة المصدر
For i = 1 To UBound(Arr, 1)

 'رقم عمود الشرط
If Arr(i, 23) Like "*" & dep & "*" Then

'If Arr(i, 101) = dep Then
 '    العداد لتحديد طول المصفوفة الهدف
p = p + 1

 '     عرض المصفوفة الهدف
For j = 1 To UBound(Arr, 2)

'  تعبئة المصفوفة الهدف من المصفوفة المصدر حسب الشرط
Temp(p, j) = Arr(i, j)

Next
End If
Next

 '  خليه البدايه لصفحه الهدف
 'عرض البيانات المطلوبة
If p > 0 Then sh.Range("A7").Resize(p, UBound(Temp, 2)).Value = Temp

       sh.Range("A7:AC" & Rows.Count).Borders.Value = 0
        
        'سطر لاضافة التسطير
       sh.Range("A7:AC" & Cells(Rows.Count, 2).End(xlUp).Row).Borders _
       .Weight = xlMedium
        
     ' .Weight = xlThin
     ' .Weight = xlMedium
     ' .Weight = xlThick

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub

استدعاء صفحه كامله لصفحه لها نفس رؤوس الاعمده

**ناصر سعيد** · نوفمبر 18, 2017


'===========================
'هذا الكود للمحترم النابغه ياسر خليل
'الهدف من الكود هو استدعاء بشرط
'تم هذا الكود في 15/2/2017
    Sub استدعاء_بدون_شرط()
      On Error Resume Next
    Dim Arr     As Variant
    Dim Temp    As Variant
    Dim cr      As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim c       As Long
    Dim ws As Worksheet
    Dim sh As Worksheet
    Set ws = Sheets("المصدر")
    Set sh = Sheets("الهدف (2)")
    '= = = = = = = = = = = =
    ' شيت الهدف والمدى المطلوب مسحه
    sh.Range("A7:AC10000").ClearContents
    
        ' اسم ورقة المصدر
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
            'متغير اسم ورقة المصدرومدى البيانات بها
    Arr = ws.Range("A7:AC" & lr).Value
    
    ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    
    'ارقام الاعمده المطلوب نقلها
    cr = Array(2, 3, 7, 8, 9, 23, 28, 29)
      j = 1

    For i = LBound(Arr, 1) To UBound(Arr, 1)
    
   ' المعيار او الشرط الذي نبحث به ورقم عمود المعيار
       ' If arr(i, 135) Like "*" & "نا*" & "*" Then
            Temp(j, 1) = j
            For c = LBound(cr) To UBound(cr)
                Temp(j, c + 2) = Arr(i, cr(c))
            Next c
            j = j + 1
       ' End If
    Next i
    
    ' اسم شيت الهدف
    With sh
    
    'خليه بدايه اللصق في الشيت الهدف
        .Range("A7").Resize(j - 1, UBound(Temp, 2)).Value = Temp
        
        'سطر لمسح التسطير
        .Range("A7:AC" & Rows.Count).Borders.Value = 0
        
        'سطر لاضافة التسطير
        .Range("A7:AC" & .Cells(Rows.Count, 2).End(xlUp).Row).Borders.Value = 1
    End With
End Sub

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

**ناصر سعيد** · نوفمبر 18, 2017

 
'===========================
'هذا الكود للمحترم النابغه ياسر خليل
'  الهدف من الكود هو استدعاء بشرط من خارج الكود
'وكذلك الاستدعاء بدون شرط بسطر برمجي موجود
'وقد تم التنويه داخل الكود عن السطر المسئول
'تم هذا الكود في 15/2/2017
    '==================
    Sub استدعاء_بمعيار1()
    Dim arr     As Variant
    Dim temp    As Variant
    Dim cr      As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim c       As Long
    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim myArray, targt, targt1
    Set Main = Sheets("المصدر")
    Set sh = Sheets("Sheet2")

    targt = sh.Range("C1").Value   'خلية البحث

    '= = = = = = = = = = = =
    ' شيت الهدف والمدى المطلوب مسحه
    sh.Range("B7:AE1000").ClearContents
    
        ' عدد الصفوف في ورقة المصدر
    lr = Main.Cells(Rows.Count, 1).End(xlUp).Row
    
            'متغير اسم ورقة المصدرومدى البيانات بها
    arr = Main.Range("A7:EF" & lr).Value
    
    ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    
    'ارقام الاعمده المطلوب نقلها
    cr = Array(2, 3, 7, 8, 9, 11, 5, 135)
    
    j = 1
 
    For i = LBound(arr, 1) To UBound(arr, 1)
    '==================
    'اذا أردت  ان يستدعي بيانات بشرط
    'ماعليك الا ان تجعل السطر البرمجي الموجود
    'اسفل هذا السطر يعمل
    '==================
               'رقم عمود الذي سيتم البحث فيه
      '  If arr(i, 5) Like targt & "*" Then
If arr(i, 5) = targt Then
    '==================
            temp(j, 1) = j
            For c = LBound(cr) To UBound(cr)
                temp(j, c + 2) = arr(i, cr(c))
            Next c
            j = j + 1
    '==================
        End If
    '==================
    Next i
    
    With sh
    
    'خليه بدايه اللصق في شيت الهدف
        .Range("B7").Resize(j - 1, UBound(temp, 2)).Value = temp
        
        'سطر لمسح التسطير
        .Range("B7:AJ" & Rows.Count).Borders.Value = 0
        
        'سطر لاضافة التسطير
        .Range("B7:AJ" & .Cells(Rows.Count, 2).End(xlUp).Row).Borders.Value = 1
    End With
End Sub

استدعاء بيانات اعمده معينه بشرط من خارج الكود

**ناصر سعيد** · نوفمبر 18, 2017

'===========================
'هذا الكود للمحترم النابغه ياسر خليل
'الهدف من الكود هو استدعاء بشرطين
'وكذلك الاستدعاء بدون شرط
'وقد تم التنويه داخل الكود عن السطر المسئول
'تم هذا الكود في 15/2/2017
    '==================
    Sub استدعاء_بشرطين_من_داخل_الكود()
    Dim Arr     As Variant
    Dim Temp    As Variant
    Dim cr      As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim c       As Long
    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim myArray, targt, targt1
    targt = "ذك*"
    targt2 = "نا*"

    Set Main = Sheets("المصدر")
    Set sh = Sheets("الهدف (5)")
    '= = = = = = = = = = = =
    ' شيت الهدف والمدى المطلوب مسحه
    sh.Range("B7:AC1000").ClearContents
    
        ' عدد الصفوف في ورقة المصدر
    lr = Main.Cells(Rows.Count, 1).End(xlUp).Row
    
            'متغير اسم ورقة المصدرومدى البيانات بها
    Arr = Main.Range("A7:EF" & lr).Value
    
    ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    
    'ارقام الاعمده المطلوب نقلها
    cr = Array(2, 3, 7, 8, 9, 11, 23, 28)
    
    j = 1
 
    For i = LBound(Arr, 1) To UBound(Arr, 1)
    '==================
    'اذا أردت  ان يستدعي بيانات بدون شرط
    'ماعليك الا ان تجعل السطر البرمجي الموجود
    'اسفل هذا السطر لا يعمل
    '==================
               'رقم عمود الذي سيتم البحث فيه
       If Arr(i, 28) Like targt & "*" _
       And Arr(i, 23) Like targt2 & "*" Then


    '==================
            Temp(j, 1) = j
            For c = LBound(cr) To UBound(cr)
                Temp(j, c + 2) = Arr(i, cr(c))
            Next c
            j = j + 1
    '==================
        End If
    '==================
    Next i
    
    With sh
    
    'خليه بدايه اللصق في شيت الهدف
        .Range("A7").Resize(j - 1, UBound(Temp, 2)).Value = Temp
        
        'سطر لمسح التسطير
        .Range("B7:AJ" & Rows.Count).Borders.Value = 0
        
        'سطر لاضافة التسطير
        .Range("B7:AJ" & .Cells(Rows.Count, 2).End(xlUp).Row).Borders.Value = 1
    End With
End Sub

استدعاء_بشرطين_من_داخل_الكود

**ناصر سعيد** · نوفمبر 18, 2017

'===========================
'هذا الكود للمحترم النابغه ياسر خليل
'الهدف من الكود هو استدعاء بشرطين من صفحه الاكسيل
'وكذلك الاستدعاء بدون شرط
'وقد تم التنويه داخل الكود عن السطر المسئول
'تم هذا الكود في 15/2/2017
    '==================
    Sub استدعاء_بمعيارين_من_الخارج()
      On Error Resume Next
    Dim Arr     As Variant
    Dim Temp    As Variant
    Dim cr      As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim c       As Long
    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim myArray, targt, targt2
    
    Set Main = Sheets("المصدر")
    Set sh = Sheets("الهدف (4)")
    
    If sh.Range("C1").Value = "" Then
    MsgBox "المعيار الاول غير محجوز ..... برجاء تأكد من ادخال البانات وحاول مرة اخرى"
    Exit Sub
    Else
    If sh.Range("D1").Value = "" Then
    MsgBox "المعيار الثانى غير محجوز ..... برجاء تأكد من ادخال البانات وحاول مرة اخرى"
    Exit Sub
    Else
    targt = sh.Range("C1").Value & "*"
    targt2 = sh.Range("D1").Value & "*"
    'targt = "ذك*"
    'targt2 = "نا*"

    '= = = = = = = = = = = =
    ' شيت الهدف والمدى المطلوب مسحه
    sh.Range("A7:AC1000").ClearContents
    
        ' عدد الصفوف في ورقة المصدر
    lr = Main.Cells(Rows.Count, 1).End(xlUp).Row
    
            'متغير اسم ورقة المصدرومدى البيانات بها
    Arr = Main.Range("A7:EF" & lr).Value
    
    ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    
    'ارقام الاعمده المطلوب نقلها
    cr = Array(2, 3, 7, 8, 9, 23, 28)
    
    j = 1
 
    For i = LBound(Arr, 1) To UBound(Arr, 1)
    '==================
    'اذا أردت  ان يستدعي بيانات بدون شرط
    'ماعليك الا ان تجعل السطر البرمجي الموجود
    'اسفل هذا السطر لا يعمل
    '==================
               'رقم عمود الذي سيتم البحث فيه
       If Arr(i, 28) Like targt & "*" _
       And Arr(i, 23) Like targt2 & "*" Then


    '==================
            Temp(j, 1) = j
            For c = LBound(cr) To UBound(cr)
                Temp(j, c + 2) = Arr(i, cr(c))
            Next c
            j = j + 1
    '==================
        End If
    '==================
    Next i
    
    With sh
    
    'خليه بدايه اللصق في شيت الهدف
        .Range("A7").Resize(j - 1, UBound(Temp, 2)).Value = Temp
        
        'سطر لمسح التسطير
        .Range("A7:AJ" & Rows.Count).Borders.Value = 0
        
        'سطر لاضافة التسطير
        .Range("A7:AJ" & .Cells(Rows.Count, 2).End(xlUp).Row).Borders.Value = 1
    End With
End If
End If
End Sub

استدعاء_بمعيارين_من_الخارج

**ناصر سعيد** · نوفمبر 19, 2017

	'===========================
'هذا الكود للمحترم النابغه ياسر خليل
'الهدف من الكود هو استدعاء بشرطين من صفحه الاكسيل
'وكذلك الاستدعاء بدون شرط
'وقد تم التنويه داخل الكود عن السطر المسئول
'تم هذا الكود في 15/2/2017
    '==================
    Sub استدعاء_بمعيارين_من_الخارج()
      On Error Resume Next
    Dim Arr     As Variant
    Dim Temp    As Variant
    Dim cr      As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim c       As Long
    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim myArray, targt, targt2
    
    Set Main = Sheets("المصدر")
    Set sh = Sheets("الهدف (4)")
    
    If sh.Range("C1").Value = "" Then
    MsgBox "المعيار الاول غير محجوز ..... برجاء تأكد من ادخال البانات وحاول مرة اخرى"
    Exit Sub
    Else
    If sh.Range("D1").Value = "" Then
    MsgBox "المعيار الثانى غير محجوز ..... برجاء تأكد من ادخال البانات وحاول مرة اخرى"
    Exit Sub
    Else
    targt = sh.Range("C1").Value & "*"
    targt2 = sh.Range("D1").Value & "*"
    'targt = "ذك*"
    'targt2 = "نا*"
	    '= = = = = = = = = = = =
    ' شيت الهدف والمدى المطلوب مسحه
    sh.Range("A7:AC1000").ClearContents
    
        ' عدد الصفوف في ورقة المصدر
    lr = Main.Cells(Rows.Count, 1).End(xlUp).Row
    
            'متغير اسم ورقة المصدرومدى البيانات بها
    Arr = Main.Range("A7:EF" & lr).Value
    
    ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    
    'ارقام الاعمده المطلوب نقلها
    cr = Array(2, 3, 7, 8, 9, 23, 28)
    
    j = 1
 
    For i = LBound(Arr, 1) To UBound(Arr, 1)
    '==================
    'اذا أردت  ان يستدعي بيانات بدون شرط
    'ماعليك الا ان تجعل السطر البرمجي الموجود
    'اسفل هذا السطر لا يعمل
    '==================
               'رقم عمود الذي سيتم البحث فيه
       If Arr(i, 28) Like targt & "*" _
       And Arr(i, 23) Like targt2 & "*" Then
	
    '==================
            Temp(j, 1) = j
            For c = LBound(cr) To UBound(cr)
                Temp(j, c + 2) = Arr(i, cr(c))
            Next c
            j = j + 1
    '==================
        End If
    '==================
    Next i
    
    With sh
    
    'خليه بدايه اللصق في شيت الهدف
        .Range("A7").Resize(j - 1, UBound(Temp, 2)).Value = Temp
        
        'سطر لمسح التسطير
        .Range("A7:AJ" & Rows.Count).Borders.Value = 0
        
        'سطر لاضافة التسطير
        .Range("A7:AJ" & .Cells(Rows.Count, 2).End(xlUp).Row).Borders.Value = 1
    End With
End If
End If
End Sub

استدعاء_ بشرطين _من _ الخارج

**ناصر سعيد** · نوفمبر 19, 2017

تم تكرار المشاركه السابقه سهوا

**۩◊۩ أبو حنين ۩◊۩** · نوفمبر 20, 2017

السلام عليكم

الاخ ناصر سعيد

تجميعه ممتاذه جزاك الله كل الخير

والشكر موصول للاستاذ القدير ياسر ابو البراء

له منى خاصاً ومن الجميع كل الشكر والتقدير

على تعاونه وابداعاته التى تفيد قطاع كبير

ودائما نجدها عند الحاجه

جزاه الله كل الخير والتقدير

**ناصر سعيد** · نوفمبر 20, 2017

    Sub Test()
'الهدف من الكود استدعاء اعمده معينه بشرط
'الشرط من صفحه اكسيل (من خارج الكود )
'باضافه للمحترم ياسر العربي

    Dim arr     As Variant
    Dim temp    As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim Main As Worksheet
    Dim sh As Worksheet
    Dim targt
    Set Main = Sheets("Received shipments")
    Set sh = Sheets("Shipments")
    targt = sh.Range("C1").Value
    sh.Range("A5:F5000").ClearContents
    lr = Main.Cells(Rows.Count, 1).End(xlUp).Row
    arr = Main.Range("A5:F" & lr).Value
    ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    j = 1
    For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 1) Like targt Then
                temp(j, 1) = arr(i, 1)
                temp(j, 2) = arr(i, 2)
                temp(j, 3) = arr(i, 4)
                temp(j, 4) = arr(i, 3)
                temp(j, 5) = arr(i, 5)
                temp(j, 6) = arr(i, 6)
            j = j + 1
        End If
    Next i
    With sh
         .Range("A5").Resize(j - 1, UBound(temp, 2)).Value = temp
         .Range("A5:F" & Rows.Count).Borders.Value = 0
        .Range("A5:F" & .Cells(Rows.Count, 2).End(xlUp).Row).Borders.Value = 1
    End With
End Sub

الهدف من الكود استدعاء اعمده معينه بشرط
الشرط من صفحه اكسيل (من خارج الكود )
باضافه للمحترم ياسر العربي

=========

الاخ الكريم

۩◊۩ أبو حنين ۩◊۩

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

**ناصر سعيد** · نوفمبر 29, 2017

   Sub Test()
   'هذا الكود للمحترم ياسر العربي
   'وتم اضافه وضع المسلسل بواسطه المهذب بن عليه
   'حفظهم الله
   'الهدف من الكود هو استدعاء بيانات اعمده
   ' لاعمده متفرقه مع وضع المسلسل توماتيكي
   '===========
    Dim arr     As Variant
    Dim temp    As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim Main As Worksheet
    Dim sh As Worksheet
    Dim targt
    
    Set Main = Sheets("رصد الترم الثانى")
    Set sh = Sheets("بيانات الطلبة (2)")
    
    'خليه البحث
    targt = sh.Range("D1").Value
    
      'مدى المسح في صفحه الهدف
    sh.Range("B7:AN1000").ClearContents
    lr = Main.Cells(Rows.Count, 1).End(xlUp).Row
    
    'مدى الصفحه الرئيسيه المصدر
    arr = Main.Range("A7:GB" & lr).Value
    ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    j = 1
    For i = LBound(arr, 1) To UBound(arr, 1)
    
       'If arr(i, 133) Like targt Then
    'رقم عمود البحث
        If arr(i, 133) Like targt & "*" Then

' رقم عمود المسلسل
 temp(j, 1) = j
               
      'العمود الاول بعد المسلسل
                 temp(j, 2) = arr(i, 2)
                'temp(j, 3) = arr(i, 3)
                 temp(j, 4) = arr(i, 3)
                 temp(j, 5) = arr(i, 141)
                 temp(j, 6) = arr(i, 140)
                 temp(j, 7) = arr(i, 149)
                 temp(j, 8) = arr(i, 150)
                 temp(j, 9) = arr(i, 151)
                 temp(j, 10) = arr(i, 145)
                 temp(j, 11) = arr(i, 142)
                 temp(j, 12) = arr(i, 143)


            j = j + 1
        End If
    Next i
    With sh
    
    'خليه بدايه اللصق
         .Range("A7").Resize(j - 1, UBound(temp, 2)).Value = temp
         
         'مدى المسح في صفحة الهدف
        .Range("B7:AM" & Rows.Count).Borders.Value = 0
        
        'سطر لاضافة التسطير
        .Range("A7:P" & .Cells(Rows.Count, 4).End(xlUp).Row).Borders.Value = 1
    End With
End Sub

الهدف من الكود هو استدعاء بيانات اعمده
' لاعمده متفرقه مع وضع المسلسل توماتيكي

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

المحترم بن عليه حاجي4.rar

**ناصر سعيد** · أغسطس 25, 2019

الكود من اعمال الاستاذ الكبير سليم حاصبيا
تعديل بإضافة سطر لمسح المحتويات قبل الترحيل حتى لو أنه كان هناك تعديل لا يستبب في مشاكل 
التعديل للاستاذ الكبير احمد بدره

Private Sub ComboBox1_Change()
Dim R As Integer, M%: M = 5
Dim My_sh As Worksheet
   Application.ScreenUpdating = False
    Select Case Me.ComboBox1.Value
        Case "راسب": Set My_sh = Sheets("رسوب")
        Case "ناجح": Set My_sh = Sheets("ناجح")
        Case "دور ثانى": Set My_sh = Sheets("دور ثان فى")
        Case Else: GoTo End_Me
   End Select
 My_sh.Range("A5:t1005").ClearContents
For R = 5 To 100
   If Sheets("الشيت").Cells(R, 20) = Me.ComboBox1.Value Then
      Sheets("الشيت").Range("A" & R).Resize(1, 20).Copy
       My_sh.Range("A" & M).PasteSpecial xlPasteValues
     
             
            M = M + 1
       End If
       Next
End_Me:
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
     End Sub

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

https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=163650

تسجيل الدخول

اكواد الترحيل والاستدعاءات .. المرجع

الردود الموصى بها

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information