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

الله11

جميع الاصدارات القرآنية بجودةعالية وصوت نقي جدا جدا جدا-جميع المرئيات الاسلامية لمعظم الشيوخ-برامج-كتب-موسوعات-برامج محاسبيةpech tree-صور........
 
الرئيسيةالبوابةأحدث الصورالتسجيلدخول

 

 ترحيل البيانات بواسطة الأكسيل

اذهب الى الأسفل 
كاتب الموضوعرسالة
المدير العام
المدير العام
المدير العام
المدير العام


المساهمات : 40
تاريخ التسجيل : 03/11/2008
العمر : 44

ترحيل البيانات بواسطة الأكسيل Empty
مُساهمةموضوع: ترحيل البيانات بواسطة الأكسيل   ترحيل البيانات بواسطة الأكسيل Emptyالثلاثاء نوفمبر 11, 2008 11:59 pm

شاهدنا في الموضوع التالي http://www.hiarab.net/article6308.html برنامج لمتابعة المراجعين . وأعتقد أن الكثيرون قد أندهشوا لإمكانيات الأكسيل في القدره على تنفيذ العديد من رغباتنا .

* إذاً كيف تتم عملية ترحيل البيانات ؟ في المثال المرفق ستجد ورقتا عمل " Invoice " " List" وسيتم إدخال البيانات في الورقه " Invoice " ثم بعد الإنتهاء نضغط على الزر لتنتقل في أماكن محدده بورقة العمل " List " ..

* تعالوا نرى الكود
كود:

Sub MoveData()
Dim EndRow As Long
If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").Value = "" Or Sheets("Invoice").Range("a5").Value = "" Or Sheets("Invoice").Range("D6").Value = "" Or Sheets("Invoice").Range("B8").Value = "" Or Sheets("Invoice").Range("D8").Value = "" Then
MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ"
Else
EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count
Sheets("List").Cells(EndRow + 1, 1).Value = EndRow
Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value
Sheets("List").Cells(EndRow + 1, 3).Value = Sheets("Invoice").Cells(3, 4).Value
Sheets("List").Cells(EndRow + 1, 4).Value = Sheets("Invoice").Cells(5, 1).Value
Sheets("List").Cells(EndRow + 1, 5).Value = Sheets("Invoice").Cells(6, 4).Value
Sheets("List").Cells(EndRow + 1, 6).Value = Sheets("Invoice").Cells(8, 2).Value
Sheets("List").Cells(EndRow + 1, 7).Value = Sheets("Invoice").Cells(8, 4).Value
Sheets("Invoice").Range("B3,D3,A5:D5,D6,B8,D8").ClearContents
MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد"
End If
End Sub

* الكود السابق هو الخاص بعملية الترحيل من الورقه " Invoice " الي الورقه " List " ولكن ماذا يعني الكود وكيف نعدل فيه حسب الرغبه ؟

* في الكود التالي وضعنا شرط على الخلايا التي يتم إدخال البيانات بها بالورقه "Invoice" بحيث تظهر رساله تفيد بأنه يجب التأكد من إدخال كافة البيانات مع العلم أنه يمكن الأستغناء عن بعض الخلايا أو كلها بحذف الشرط أو جزأ منه
كود:

If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").Value = "" Or Sheets("Invoice").Range("a5").Value = "" Or Sheets("Invoice").Range("D6").Value = "" Or Sheets("Invoice").Range("B8").Value = "" Or Sheets("Invoice").Range("D8").Value = "" Then
MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ"

* وهنا سيبدأ البحث عن أول صف فارغ لنقل البيانات أليه مع الترقيم في العمود A مع العلم بأننا سنتطرق لموضوع الترقيم في درس مستقل آخر
كود:

EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count

* هنا سيقوم بنقل البيانات المدخله في الورقه "Invoice" في الخليه الموجوده في الصف الثالث - العمود الثاني الي الورقه " List " في الخليه الموجوده في العمود الثاني - الصف الأول
كود:

Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value

* وهكذا ينطبق الكود السابق على باقي الخلايا المدخل بها البيانات الي أن نصل الي

* هذا الكود يقوم بمسح البيانات المدخله بالورقه " Invoice" بعد نقلها للورقه " List "
كود:

Sheets("Invoice").Range("B3,D3,A5:D5,D6,B8,D8").ClearContents

* بقي كود يظهر رسالة تأكيد بإنتهاء العمليه بنجاح
كود:

MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد"

* أرجو أن تكون الفكره قد أتضحت

الرابط هنا

http://www.hiarab.net/attachments/college69/2716d1123569091
الرجوع الى أعلى الصفحة اذهب الى الأسفل
https://allah11.mam9.com
 
ترحيل البيانات بواسطة الأكسيل
الرجوع الى أعلى الصفحة 
صفحة 1 من اصل 1

صلاحيات هذا المنتدى:لاتستطيع الرد على المواضيع في هذا المنتدى
الله11 :: قسم البرامج بالإضافة الى البرامج المحاسبية-
انتقل الى: