أكاديمية الصقر للتدريب

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


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





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

السلام عليكم ورحمه الله وبركاته ارجو منكم افادتى في كود ترحيل من اليست بوكس الي الشيت عند الترحيل يتم ترحيل البيانات ف ..


موضوع مغلق


24-03-2021 08:01 مساء
mahmoud20212021
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 24-03-2021
رقم العضوية : 22063
المشاركات : 8
الجنس : ذكر
تاريخ الميلاد : 30-8-1994
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 10
 offline 

السلام عليكم ورحمه الله وبركاته 
ارجو منكم افادتى في كود ترحيل من اليست بوكس الي الشيت 
عند الترحيل يتم ترحيل البيانات فوق بعضها 
اريد الترحيل بعد اخر صف به بيانات
 هو يشبه هذا الملف كثير وعند الضغط على ترحيل يتم ترحيل البيانات واذا تم الضغط على ترحيل اصناف اخرى يتم الترحيل على البيانات السابقة ولم يتم الترحيل بعد أخر صف بة بيانات
 
 
  listbox.xlsm   تحميل xlsm مرات التحميل :(6)
الحجم :(23.462) KB



أفضل إجابة مقدمة من salim وهي:
لا أعلم اذا كان هذا ما تريده

Private Sub Cmd_Clera_Click()
Me.ListBox1.Clear
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++

Private Sub CommandButton1_Click()
 For I = 1 To 9
 Me.Controls("TextBox" & I) = _
  Chr(Application.RandBetween(65, 90)) & " " & _
  Chr(Application.RandBetween(65, 90))
 Next
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++

Private Sub ADD_To_shett_Click()
If Me.ListBox1.ListCount = 0 Then Exit Sub
Dim z%
 With Sheets("sheet1")
 z = .Cells(Rows.Count, 1).End(3).Row + 1
   .Cells(z, 1).Resize(ListBox1.ListCount, 9).Value = _
    ListBox1.List
 End With
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++
Private Sub ADD_To_list_Click()
Dim n As Byte, t, k%
For t = 1 To 9
 If Me.Controls("TextBox" & t) <> vbNullString Then
 k = k + 1
End If
Next
 If k Then
With Me.ListBox1
   .AddItem
     For n = 0 To .ColumnCount - 1
    .List(.ListCount - 1, n) = _
     Me.Controls("TextBox" & n + 1)
    Next
   End With
 End If
End Sub


الملف مرفق
عرض الإجابة




25-03-2021 01:43 مساء
مشاهدة مشاركة منفردة [1]
ابراهيم الحداد
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 232
الجنس : ذكر
الدعوات : 4
يتابعهم : 0
يتابعونه : 33
قوة السمعة : 2179
عدد الإجابات: 28
 offline 
look/images/icons/i1.gif كود ترحيل من الليست بوكس الي الشيت
السلام عليكم ورحمة الله
استبدل ذلك السطر
Z=3

بهذا السطر
        Z = Sheet1.Range("A" & Rows.Count).End(3).Row

وقم بالغاء هذا السطر
 Z=Z+1
و هكذا مع باقى الاكواد

27-03-2021 08:23 صباحا
مشاهدة مشاركة منفردة [2]
mahmoud20212021
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 24-03-2021
رقم العضوية : 22063
المشاركات : 8
الجنس : ذكر
تاريخ الميلاد : 30-8-1994
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 10
 offline 
look/images/icons/i1.gif كود ترحيل من الليست بوكس الي الشيت
استاذ ابراهيم الحداد للأسف لا يعمل أيضاً أرجو من حضرتك أفادتى به لانة أمر ضرورى بالنسبة لي . وشكراً

27-03-2021 09:12 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif كود ترحيل من الليست بوكس الي الشيت
السلام عليكم أخي الكريم محمود وأهلاً بك في المنتدى
المنتدى قائم على عملية التعلم ، لذا لابد أن تطبق الحلول المقترحة بنفسك (لا أن يتم إرفاق ملف وحسب .. لأن إرفاق الملف لن يفيدك في تعلم كيف تم حل المشكلة وبالتالي لن تستفيد ولن يستفيد غيرك)

افتح الملف المرفق لديك وقم أولاً بتسمية زر الأمر "إضافة لليست بوكس" من خلال نافذة الخصائص إلى cmdAdd
B5keP_01

كرر الخطوة السابقة مع زر "ترحيل" وقم بتسمية الزر cmdTransfer

ثم قم بالدخول إلى أكواد الفورم (كليك يمين على الفورم من نافذة المشروع ثم اختر View Code)
M36po_02

وأخيراً قم بمسح الأكود الموجودة واستخدم الكود التالي
Option Explicit

Private Sub cmdAdd_Click()
    Dim v As Long, i As Long
    v = ListBox1.ListCount
    ListBox1.AddItem
    For i = 0 To ListBox1.ColumnCount - 1
        ListBox1.List(v, i) = Controls("TextBox" & i + 1).Text
    Next i
End Sub

Private Sub cmdTransfer_Click()
    Dim m As Long, v As Long, x As Long
    With ThisWorkbook.Worksheets("Sheet1")
        m = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        For v = 0 To ListBox1.ListCount - 1
            For x = 0 To ListBox1.ColumnCount - 1
                .Cells(m, x + 1).Value = ListBox1.List(v, x)
            Next x
            m = m + 1
        Next v
    End With
End Sub
 
 


27-03-2021 09:51 صباحا
مشاهدة مشاركة منفردة [4]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif كود ترحيل من الليست بوكس الي الشيت
لا أعلم اذا كان هذا ما تريده

Private Sub Cmd_Clera_Click()
Me.ListBox1.Clear
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++

Private Sub CommandButton1_Click()
 For I = 1 To 9
 Me.Controls("TextBox" & I) = _
  Chr(Application.RandBetween(65, 90)) & " " & _
  Chr(Application.RandBetween(65, 90))
 Next
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++

Private Sub ADD_To_shett_Click()
If Me.ListBox1.ListCount = 0 Then Exit Sub
Dim z%
 With Sheets("sheet1")
 z = .Cells(Rows.Count, 1).End(3).Row + 1
   .Cells(z, 1).Resize(ListBox1.ListCount, 9).Value = _
    ListBox1.List
 End With
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++
Private Sub ADD_To_list_Click()
Dim n As Byte, t, k%
For t = 1 To 9
 If Me.Controls("TextBox" & t) <> vbNullString Then
 k = k + 1
End If
Next
 If k Then
With Me.ListBox1
   .AddItem
     For n = 0 To .ColumnCount - 1
    .List(.ListCount - 1, n) = _
     Me.Controls("TextBox" & n + 1)
    Next
   End With
 End If
End Sub


الملف مرفق
 
 
  Moh_21.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(35.766) KB


27-03-2021 11:29 صباحا
مشاهدة مشاركة منفردة [5]
mahmoud20212021
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 24-03-2021
رقم العضوية : 22063
المشاركات : 8
الجنس : ذكر
تاريخ الميلاد : 30-8-1994
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 10
 offline 
look/images/icons/i1.gif كود ترحيل من الليست بوكس الي الشيت
شكراً أخى على أهتمامك بالموضوع وانا أريد التعلم وليس أن يفعل أحد لى لكن لم يكن أحد يهتم بأمر موضوعى

27-03-2021 01:47 مساء
مشاهدة مشاركة منفردة [6]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif كود ترحيل من الليست بوكس الي الشيت
الفكرة في أن الجميع ليس متفرغ للمنتدى فكل أعضاء المنتدى يتحينون الفرصة لتقديم المساعدة قدر استطاعتهم وقدر وقتهم.



الكلمات الدلالية
ترحيل ، الليست ، بوكس ، الشيت ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 05:33 صباحا