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

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


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

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

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

وشكرا لكم

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

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

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

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

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

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

بارك الله فيك

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

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

الملف المرفق

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

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

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

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

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

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

لذا فانا الان قد وضحت وضحت المطلوب في الملف المرفق بعد اضافة بعض الملاحظات 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

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

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

شكرا لك استاذي على الرد .لكن عندما عملت ماكرو جديد ثم قمت بتعيين زر عن طريق النماذج وربطه ب 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

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

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

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

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

(y) :fff::fff::fff:

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

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

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

اللي في ملف 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

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

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

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

  • 6 months later...

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

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

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

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

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

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

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

  • 1 year later...

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

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

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

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

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

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information