الترحيل عن طريق زر الخيار الموجود في ادوات التحكم

[skyblue]

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

اخواني المبرمجين عندي بيانات في الورقة رقم 1 في اكسل ارغب في نقل مااحتاجه فقط الى الورقة رقم 2 , فمثلا عندما ارغب في نقل حساب معين اضغط زر الخيار فينتقل الحساب بالكامل على طول الى الورقة رقم 2 .

وشكرا لكم

[محمد حجازي]

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

راجع الروابط التالية:

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

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

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

بالتوفيق

[jakord]

الأخ محمد حجازي بارك الله فيك

الموضوع أنني أريد عمل زر تحكم : مربع تحرير وسرد من قائمة combo box

بصراحة لم أجد ما يسعفني

هل يمكنك التعديل على الملف المرفق؟

بارك الله فيك

[jakord]

أرجو توضيح خلصية استخدام زر زر تحكم : مربع تحرير وسرد من قائمة combo box في ترحل بيانات سجل واحد (صف من ورقة عمل) إلى ورقة العمل الثانية كي أقوم بطباعة هذه البيانات لوحدها دون باقي البيانات.وفي كل مرة أريد بواسطة زر ماكرو طلب ترحيل سجل آخر وهكذا...

الملف المرفق

في الرابط التالي

http://www.geocities.com/jakord/Marks.xls

[skyblue]

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

استاذي الفاضل محمد حجازي حفظه الله ورعاه

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

لذا فانا الان قد وضحت وضحت المطلوب في الملف المرفق بعد اضافة بعض الملاحظات book114

برجاء مساعد تي انت فأنا محتاج لله ثم لك .

ولك مني كل الشكر والتقدير والاحترام وربي يحفظك .

[محمد حجازي]

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

يا أخي ، لماذا الترقب و الانتظار .

أظن أنك لو قرأت المواضيع الموجودة في الوصلات السابقة و الشرح الموجود فيها بتمعن لكنت وصلت للحل بدون انتظار أحد.

على أية حال ، سأعطيك الطريقة وعليك تنفيذها لوحدك في الملف الموجود عندك ، لاحظ الكود التالي:

Sub Tarhel7()
  Dim EndRow As Long
  Dim Range1 As String
  Dim Range2 As String
  EndRow = Sheets("Sheet2").Range("B5").CurrentRegion.Rows.Count + 5
  Range1 = "B" & 7 & ":W" & 7
  Range2 = "B" & EndRow & ":W" & EndRow
  Worksheets("Sheet2").Range(Range2).Value = Worksheets("Sheet1").Range(Range1).Value
End Sub

الكود السابق يقوم بنقل الحساب الموجود في الصف السابع من الورقة الأولى Sheet1 إلى الورقة الثانية Sheet2 ، وبالتالي فيمكنك ربط الكود السابق بالزر المخصص لنقل بيانات الصف السابع (لفهم الكود السابق راجع الشرح الموجود في الروابط أعلاه). الآن يجب تكرير الكود السابق لكل زر (وذلك مع تغيير رقم السطر الموجود ضمن المتغيير Range1) ، ولكن هذه الطريقة معقدة بعض الشيئ! الحل يكمن في إنشاء إجراء رئيسي MyTarhel و استخدامه في تكوين طرق متعددة Tarhel8 ، Tarhel9 ، Tarhel10 ،الخ (لكل زر أمر) ، وذلك كما في الكود التالي:

Sub MyTarhel(MyRow As Integer)
  Dim EndRow As Long
  Dim Range1 As String
  Dim Range2 As String
  EndRow = Sheets("Sheet2").Range("B5").CurrentRegion.Rows.Count + 5
  Range1 = "B" & MyRow & ":W" & MyRow
  Range2 = "B" & EndRow & ":W" & EndRow
  Worksheets("Sheet2").Range(Range2).Value = Worksheets("Sheet1").Range(Range1).Value
End Sub
Sub Tarhel8()
  Call MyTarhel(8)
End Sub
Sub Tarhel9()
  Call MyTarhel(9)
End Sub
Sub Tarhel10()
  Call MyTarhel(10)
End Sub

[skyblue]

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

شكرا لك استاذي على الرد .لكن عندما عملت ماكرو جديد ثم قمت بتعيين زر عن طريق النماذج وربطه ب Tarhel8 تظهر لي رسالة كالاتي :

9 run time error

subscript out of range

ماالحل رجاءا . وهل يجب علي انشاء tarhel11 ثم 12 ثم 13 حسب الحاجة علما ان الجدول الرئيسي في الورقة الاولى يحتوي على 1000 صف فهل اعمل امام كل صف زر ترحيل , حيث ارى ان ذلك متعب جدا .

اذا هل يمكن عمل قائمة منسدلة بدلا من ذلك في الورقة رقم 1 تضم 1000 صف وزر ترحيل واحد فقط

فبمجرد ان اختار الصف واضغط ترحيل يقوم بالترحيل مباشرة الى الورقة رقم 2

ولك مني كل الاحترام والتقدير .

[محمد حجازي]

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

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

Sub MyTarhel()
 On Error GoTo NoName
 Dim EndRow As Long
 Dim Range1 As String
 Dim Range2 As String
 EndRow = Sheets("Sheet2").Range("B5").CurrentRegion.Rows.Count + 5
 Range1 = "B" & Sheets("Sheet1").Range("A6:A5000").Find(Sheets("Sheet1").Range("A2").Value).Row & ":W" & Sheets("Sheet1").Range("A6:A5000").Find(Sheets("Sheet1").Range("A2").Value).Row
 Range2 = "B" & EndRow & ":W" & EndRow
 Worksheets("Sheet2").Range(Range2).Value = Worksheets("Sheet1").Range(Range1).Value
 Sheets("Sheet1").Range("A2").ClearContents
Exit Sub

NoName:
 If Err = 91 Then
   MsgBox "الحساب المدخل غير موجود"
 End If

End Sub

مرفق ملفك معدل:

Book114.zip

[skyblue]

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

استاذي الفاضل محمد حجازي شكرا والف شكر على هذا التعديل الرائع وهذا مااريده فعلا

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

(y)

[skyblue]

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

اخي واستاذي محمد حجازي اتمنى يااستاذي الفاضل ان تشرح لي كيفية انشاء هذا الكود

اللي في ملف book114 لانه فعلا يفيدني كثيرا حيث انني حاولت ان افهمه ولكن لم استطيع , وبالذات هذه الجزئية من الكود

EndRow = Sheets("Sheet2").Range("B5").CurrentRegion.Rows.Count + 5

Range1 = "B" & Sheets("Sheet1").Range("A6:A5000").Find(Sheets("Sheet1").Range("A2").Value).Row & ":W" & Sheets("Sheet1").Range("A6:A5000").Find(Sheets("Sheet1").Range("A2").Value).Row

Range2 = "B" & EndRow & ":W" & EndRow

اتمنى ان تتكرم علينا بشرح الكود حتى يمكنني من معرفة كيف تم انشاء الكود .

ولك مني كل الشكر والتقدير

[محمد حجازي]

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

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

Sub MyTarhel()
On Error GoTo NoName
Dim EndRow As Long
Dim Range1 As String
Dim Range2 As String
EndRow = Sheets("Sheet2").Range("B5").CurrentRegion.Rows.Count + 5
Range1 = "B" & Sheets("Sheet1").Range("A6:A5000").Find(Sheets("Sheet1").Range("A2").Value).Row & ":W" & Sheets("Sheet1").Range("A6:A5000").Find(Sheets("Sheet1").Range("A2").Value).Row
Range2 = "B" & EndRow & ":W" & EndRow
Worksheets("Sheet2").Range(Range2).Value = Worksheets("Sheet1").Range(Range1).Value
Sheets("Sheet1").Range("A2").ClearContents
Exit Sub

NoName:
If Err = 91 Then
  MsgBox "الحساب المدخل غير موجود"
End If

End Sub

ولنبدأ بشرح الكود خطوة خطوة:

On Error GoTo NoName

بإضافة هذا السطر فإن الكود ينتقل لتنفيذ الإجراء الموجود تحت النقطة NoName عند حدوث أي خطأ أثناء تنفيذ الكود.

Dim EndRow As Long
Dim Range1 As String
Dim Range2 As String

هنا قمنا بتعريف المتغير EndRow على أنه عدد صحيح طويل ، و المتغيران Range1 و Range2 على أنهما متغيران نصيان.

EndRow = Sheets("Sheet2").Range("B5").CurrentRegion.Rows.Count + 5

هنا قمنا بإسناد رقم الصف الذي يأتي مباشرةً بعد آخر صف من نطاق البيانات الموجودة في الورقة Sheet2 في المتغير EndRow طبعاً ، و الهدف من هذا السطر هو القدرة على نقل البيانات إلى الورقة الثانية دون أن تتأثر البيانات القديمة أو يتم التسجيل فوقها.

Range1 = "B" & Sheets("Sheet1").Range("A6:A5000").Find(Sheets("Sheet1").Range("A2").Value).Row & ":W" & Sheets("Sheet1").Range("A6:A5000").Find(Sheets("Sheet1").Range("A2").Value).Row

هنا استخدمنا الأسلوب Find للبحث داخل المجال A6:A5000 الموجود في الورقة Sheet1 وذلك عن القيمة الموجودة داخل الخلية A2 الموجودة في الورقة Sheet1 وإرجاع رقم صف أول خلية يتم العثور عليها ، ودمج هذا الرقم برموز الأعمدة لتشكيل مرجع واسناده في المتغير Range1.

Range2 = "B" & EndRow & ":W" & EndRow

هنا قمنا بدمج رقم الصف الموجود داخل المتغير EndRow مع رموز الأعمدة لتشكيل مرجع واسناده في المتغير Range2.

Worksheets("Sheet2").Range(Range2).Value = Worksheets("Sheet1").Range(Range1).Value

هنا قمنا بعملية المناقلة المطلوبة (و التي تمثل الهدف الرئيسي للكود).

Sheets("Sheet1").Range("A2").ClearContents

هنا قمنا بمسح محتويات الخلية A2 الموجودة في الورقة Sheet1 (وذلك بعد القيام بعملية المناقلة السابقة).

Exit Sub

هنا تمت عملية إنهاء الكود.

NoName:
If Err = 91 Then
  MsgBox "الحساب المدخل غير موجود"
End If

كما ذكرنا سابقاً فإنه عند حدوث خطأ أثناء تشغيل الكود فإن دفة التنفيذ تنتقل مباشرة لتنفيذ الأسطر الموجودة تحت النقطة السابقة NoName. و الهدف من هذه العملية هو أن الأسلوب Find يرجع الخطأ البرمجي 91 عندما لا يكون هنالك أي نتيجة للبحث ، وهنا وبإضافة السطر التالي في أول الكود :

On Error GoTo NoName

فإننا استطعنا اصطياد هذا الخطأ ومعالجته قبل أن يؤثر على سير عمل الكود.

أرجو أن يكون شرحي وافياً ...... بالتوفيق

[skyblue]

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

اخي واستاذي محمد حجازي مشكور مشكور على هذا المجهود الرائع , فعلا انت انسان مبدع ربي يحفظك لنا .. امين

(y)

[skyblue]

اخواني المشرفين واجهتني مشكلة في الملف( book14) الموجود في هذا الموضوع وهو ان الكود الخاص به لايقبل الزيادة . حيث مقرر له ان يظهر 5000 حساب فقط في القائمة المنسدلة وانا الان احتاج ان اعدل في الكود حسب احتياجي لانه عندي حوالي 6500 حساب

علما انني عدلت الكود من A6:A5000 الى A6:A6500 ولكن بدون فائدة .

لذا ارجوا مساعدتي لجعل القائمة المنسدلة ف sheet1 في الملف book14 تظهر عدد 6500 حساب .

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

[علي السحيب]

قم بالوقوف على الخلية التي بها القائمة المنسدلة .. ثم إذهب إلى القائمة بيانات (DATA) ثم التحقق من الصحة (Validation) .. وقم بتغيير =$A$6:$A$5000 إلى =$A$6:$A$6500

[skyblue]

الله يعطيك الصحة والعافية رائع واكثر من رائع

تحياتي لك

[SPHINX]

استاذي العزيز محمد حجازي

الكود السابق جدا مفيد ، ولكن ما هو الحال لو كان المطلوب ترحيل اكثر من بيان في وقت واحد على سبيل المثال

يوجد بيانات في ورقة رقم 1 في الخلية A5 وبيان في الخلية d6 والخلية E7 ...........وهكذا

ويراد الترحيل الى شيت اخر وفي صف واحد من A الى z وعند ترحيل بيان اخر ياخذ الصف التالي ايضا من a الى z حتى لا يتم الكتابه على بيانات موجوده

مع الاخذ في الاعتبار ان هذه الورقة يستخدمها اكثر من مستخدم في وقت واحد

[SPHINX]

هل من مساعد