إكسيل

برمجة مشروع يحتوي على ازرار الاضافه ، الحفظ ، التعديل ، الحذف ، التفريغ بلغة VBA في الاكسل

صورة
صدام العويري
اخر تحديث :

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

بعد ما انتهيا من تصميم واضافه الادوات على الفورم في الدرس السابق ،  بعدها نقوم بتغير جميع Textbox برمجيا وذلك من خلال الخصائص ثم نختار name ونكتب الاسماء ادناه بما يقابلها من الليبل 



ـ namee الاسم ، 

ـsection القسم 

ـgender الجنس

ـphone الهاتف 

ـage العمر

ـaddress العنوان 

ـoccup الوظيفه

ـcert  الشهاده 



- ملاحظه الاسم namee خليت حرف e مكرر لان كلمه name محجوزه بالاكسل مايصير

شاهد الفيديو


- برمجه CombBox بحيث عند ضغط عليه يظهر لنا ذكر وانثى ولعمل ذلك نضغط على فورم نقرتين ثم نغير الحدث الى Activate ونكتب الكود التالي 



With Me.gender
.Clear
.AddItem ""
.AddItem "ذكر"
.AddItem "انثى"

End With


شاهد الفيديو للتوضيح 




برمجه الاتصال بقاعدة البيانات اكسس VBA في الاكسل 

برمجه الاتصال بقاعدة البيانات اكسس اي الورقه الي سوينه بيهه الحقول مثل مانعرف الاكسل يحتوي على اوراق وباستطاعه المستخدم حذف واضافه اي عدد يريده من الاوراق حتى نتصل بالورقه نعطي اسم معين للورقه مثلا Data , ثم نقوم بإنشاء اجراء الاتصال بقاعدة البيانات ونسميه Call refresh_data ونكتب الكود كالتالي : 



Sub refresh_data()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("data")
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("a:a"))

With Me.ListBox1
.ColumnHeads = True
.ColumnCount = 10
.ColumnWidths = "20,60,50,40,80,36,60,60,70,30"

If last_row = 1 Then
.RowSource = "data!a2:l2"
Else
.RowSource = "data!a2:l" & last_row
End If

End With

End Sub



شرح الكود 

عرفنا متغير اسمه as للاتصال بالشيت اي الورقه ثم اجرينا الاتصال set بالورقه data ثم عرفنا متغير last_row لاظهار الحقول ت ، الاسم ، القسم وغيرها 


السطر الخامس خاص بالـ ListBox 

ـ ColumnCount = 10 هذا كود خاص بعدد الحقول في قاعدة البيانات


ـ .ColumnWidths = "20,60,50,40,80,36,60,60,70,30"

هذا كود خاص بعرض الحقول في ListBox



ـ RowSource = "data!a2:l2" هذا كود خاص بدايه ونهايه الحقول حيث عندنا اول حقل يبدي من a2 وينهي بـ l2


اخر شي انهينا كود End Sub 




وبعد ما خلصنه من كتابه الاجراء نقوم بالاستعلام عن الكود في حدث الفورم بكتابه اسم الاجراء وهو 

Call refresh_data




توضيح الكود في صوره

برمجه الاتصال بقاعدة البيانات اكسس VBA في الاكسل

شاهد الفيديو للتوضيح 


برمجة كود الحفظ VBA في الاكسل 

ننقر نقرتين على زر الحفظ ونكتب الكود التالي : 



Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("data")
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("a:a"))
'--------------------------------------------
If Me.gender.Value = "" Then
MsgBox "danjhv"
Exit Sub
End If
'===============
sh.Range("a" & last_row + 1).Value = "=row()-1"
sh.Range("b" & last_row + 1).Value = Me.namee.Value
sh.Range("c" & last_row + 1).Value = Me.section.Value
sh.Range("d" & last_row + 1).Value = Me.gender.Value
sh.Range("e" & last_row + 1).Value = Me.phone.Value
sh.Range("f" & last_row + 1).Value = Me.age.Value
sh.Range("g" & last_row + 1).Value = Me.address.Value
sh.Range("h" & last_row + 1).Value = Me.occup.Value
sh.Range("I" & last_row + 1).Value = Me.cert.Value
sh.Range("j" & last_row + 1).Value = Now
'=================================================================
Me.namee.Value = ""
Me.section.Value = ""
Me.gender.Value = ""
Me.phone.Value = ""
Me.age.Value = ""
Me.address.Value = ""
Me.occup.Value = ""
Me.cert.Value = ""

Call refresh_data



شرح الكود

الاربعه اسطر في البدايه تم شرحها سابقاً وهي الاتصال بقاعدة البيانات data 



sh.Range("a" & last_row + 1).Value = "=row()-1" 


هذا كود خاص بالتسلسل اي عند اضافه اول بيانات موظف يتم اعطاء تسلسل رقم 1 ثم 2 وهكذا 



sh.Range("b" & last_row + 1).Value = Me.namee.Value


هذا كود خاص بالربط بين Textbox و الحقل الذي سوف يتم الحفظ في قاعده البيانات مثلا  حقل الادخال name في الفورم  يتم ربطه مع حقل name في قاعده البيانات مع كتابه عنوان الخليه A بمعنى مايدخله المستخدم من قيم نصيه او رقميه في حقل name في الفورم  يتم حفظه في حقل name  وهكذا في بقيه حقول الادخال



 Me.namee.Value = ""


هذا كود خاص بتفريغ الحقول بعد الحفظ اي عند كتابه البيانات في حقول والضغط على زر حفظ سوف يتم مسح البيانات على حقول لبدء الكتابه من جديد وهكذا في بقيه الاكواد




صوره توضح كود الحفظ

برمجة كود الحفظ VBA في الاكسل


فيديو يوضح كود وعملية الحفظ





 برمجه عرض البيانات على جميع Textbox


ناتي الى برمجه عرض البيانات على جميع Textbox بعد الضغط على اي صف في ListBox1 يتم اضهار البيانات على حقول Textbox ننقر نقرتين فوق ListBox1 ونكتب الكود التالي : 



Me.namee.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)

Me.section.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)

Me.gender.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 3)

Me.phone.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 4)

Me.age.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 5)

Me.address.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 6)

Me.occup.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 7)

Me.cert.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 8)


الكود سهل جدا لكن احب اوضح نقطه وهي ترقيم من 0 الى 8 لو تلاحظون في نهايه كل سطر من الكود رقم 0 ، 1 ، 3 وهكذا هذه تدل على  اضهار ترقيم الحقول في قاعده البيانات على Textbox احنه عدنه 10 حقل الحقل 1 ، 10  ماعلينه بيه اما بقيه الحقول 8 يبدا الترقيم من 1 وينتهي بـ 8





صوره توضح الكود

برمجه عرض البيانات على جميع Textbox


فيديو للتوضيح



.تكملة المشروع 


نضيف Textbox الى الفورم  وظيفه هذا الـ Textbox هو اضهار رقم البيانات عند الضغط على ListBox1 ننقر نقرتين على ListBox1 ونكتب الكود التالي 



Me.TextBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)



كود سهل هنا ضفنا Textbox4 وجعلناه عند الضغط على اي سطر في ListBox1 يتم اضهار القيمه في Textbox

اضهار رقم البيانات عند الضغط على ListBox1

شاهد الفيديو للتوضيح 




برمجه زر الحذف VBA في الاكسل

ننقر نقرتين على زر الحذف ونكتب الكود التالي : 



Dim sh As Worksheet
Set sh =

 ThisWorkbook.Sheets("data")

Dim selected_row As Long

selected_row = Application.WorksheetFunction.Match(CLng(Me.TextBox4.Value), sh.Range("a:a"), 0)


sh.Range("a" & selected_row).EntireRow.Delete


Me.namee.Value = ""
Me.section.Value = ""
Me.gender.Value = ""
Me.phone.Value = ""
Me.age.Value = ""
Me.address.Value = ""
Me.occup.Value = ""
Me.cert.Value = ""


برمجه زر الحذف VBA في الاكسل

شاهد الفيديو للتوضيح 



برمجه زر التعديل VBA في الاكسل

 ننقر نقرتين على زر التعديل ونكتب الكود التالي : 



Dim sh As Worksheet 

Set sh = ThisWorkbook.Sheets("data")

Dim selected_row As Long

selected_row = Application.WorksheetFunction.Match(CLng(Me.TextBox4.Value), sh.Range("a:a"), 0)
'------------------------------------------

sh.Range("B" & selected_row).Value = Me.namee.Value

sh.Range("C" & selected_row).Value = Me.section.Value

sh.Range("D" & selected_row).Value = Me.gender.Value

sh.Range("E" & selected_row).Value = Me.phone.Value

sh.Range("F" & selected_row).Value = Me.age.Value

sh.Range("G" & selected_row).Value = Me.address.Value

sh.Range("H" & selected_row).Value = Me.occup.Value

sh.Range("I" & selected_row).Value = Me.cert.Value

sh.Range("J" & selected_row).Value = Now
'====================
Me.namee.Value = ""
Me.section.Value = ""
Me.gender.Value = ""
Me.phone.Value = ""
Me.age.Value = ""
Me.address.Value = ""
Me.occup.Value = ""
Me.cert.Value = ""
Me.TextBox4.Value = ""

Call refresh_data




صوره توضح الكود

برمجه زر التعديل VBA في الاكسل


فيديو يوضح زر التعديل



برمجه زر  التفريغ VBA في الاكسل

ننقر نقرتين على زر التفريغ ونكتب الكود التالي : 



Dim sh As Worksheet
Set sh =

 ThisWorkbook.Sheets("data")

Dim selected_row As Long

selected_row = Application.WorksheetFunction.Match(CLng(Me.TextBox4.Value), sh.Range("a:a"), 0)


sh.Range("a" & selected_row).EntireRow.Delete


Me.namee.Value = ""
Me.section.Value = ""
Me.gender.Value = ""
Me.phone.Value = ""
Me.age.Value = ""
Me.address.Value = ""
Me.occup.Value = ""
Me.cert.Value = ""



برمجه زر التفريغ VBA في الاكسل



فيديو يوضح زر التفريغ



الى هنا ننتهي من برمجه المشروع باكملة  الخاص بادخال بيانات الموظف ، اتمنى استفاديتوا من شروحات المشروع وباستطاعة اي شخص ان يبرمج مشروع متكامل بنفس الاكواد مع زياده الحقول وتغير وتعديل في كل تفاصيل المشروع 



تعديل المقال
الأقسام

مقالات قد تهمك

تعليقات