أحمد بكر

https://youtu.be/X_hkw8MsiR4

رابط التحميل من هنا

تأكد من امتداد ملفات الاكسيل كما فى الصورة 'My Computer'. Browse 'Tools >> Folder Options >> File Types' او جرب هذا البرنامج من هنا

المشكلة ليست فى الاصدار الكود عبارة عن نسخ البيانات من Sheet1 اللى هو ادخال البيانات الى Sheet2 الى هو الفواتير الخطأ فى تسمية الشيت اضغط هنا لرؤية صورة توضيحية لعدم تظليل الخلايا بعد الترحيل زود هذة الجزئية ( بعد التنفيذ يقف في خلية E3 ويمسح ما بها وينتقل الى E4 ) Range("E3").Select Selection.ClearContents Range("E4").Select

لعد م مسح البيانات احذف هذا الجزء من الكود Sheet1.Range("A3:C3") = "" لتوسيع النطاق غير عمود C الي اى عمود تريدة لزيادة عرض النطاق ولطول النطاق هنا 50000 ممكن تزوده برده azsh = Sheet2.Range("c50000").End(xlUp).Row + 1 يمكن عمل الكود بالطريقتين بموديل او بدون موديل لو بدون موديل ممكن تحط الكود داخل الزر من المطور ,, ادراج ,, زر نوعه activeXcontrol دبل كليك على الزر وانت فى وضع المصمم مرفق الملف يعمل بدون موديل tr7eel.rar

افكار رائعه ولكن انا عايز اطوع الملف ده عشان يناسب العمل عندي فمثلا الشاشه اللي فيها الكود وارقام الموبايل والاسم عربي/انجليزي وغيرهم الهيد ده بتاع البيلنات عايز اغيرهم لاني هستعمل الملف ده في تسجيل جوازات مسافرين في شركه سياحه كل بيانات الجواز يعني مع امكانيه البحث والتعديل والالغاء وطبع سيكتور معين كنت فعلا بدور علي فكره زي اللي في الملف ده ولكن ما اريده حاليا اني اعدل عليه جزاك الله خيرا واى تعديل انا فى الخدمة

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

لو تقصد البحث برقم الموظف يعمل وتم التجربة مرة اخرى ولو تقصد البحث فى التقارير (لابد من تسجيل تاريخ انتهاء الاقامة لان البحث بيتم بين التاريخين معتمد على تاريخ انتهاء الاقامة ) يعنى تاريخ انتهاء الاقامة لازم يكون بين التاريخين المحددين ليظهر بالنتائج ممكن تعدل على الملف وتخلية تاريخ بدء العمل او ما شابة او تعدل على الفورم وتلغى بين تاريخين وتخلية بحث بناءا على المدخلات فقط وفورم البحث من انجازات الاستاذعبد الله باقشير

تحديث جديد من هنا

برنامج شئون الموظفين يعمل بالتاريخين الهجرى والميلادى. امكانية البحث برقم الموظف . امكانية ربط الموظف بصورة الموظف من اى مكان من الحاسب (وليس وضع الصور بجانب الملف كما كان مسبقا). امكانية حذف موظف او تعديل بيانات الموظف . اصدار تقارير عن موظف واحد بطباعة بياناته فى صفحة مستقلة. امكانية تصدير التقارير لملف اكسيل جديد باسم جديد. البحث بين تاريخين . امكانية طباعة عدد من الموظفين سواء (اسم الموظف - الراتب - الاقامات - الادارة التابع لها - او اى بيانات مدخلة ). التحكم فى تغيير اسم الشركة . نافذة امان قبل الدخول للبرنامج بكلمة مرور يمكن اظهار النافذة او اغلقها. امكانية التحكم فى اعدادات المظهر (خلفية البرنامج - لون الخط ). للاطلاع عن المزيد من الصور والشرح للبرنامج من هنا او الاطلاع على دليل المستخدم من البرنامج شكر خاص للأستاذ/ عبد الله باقشير حيث استخدمت الكثير من اكواده الاكثر من رائعه وكذلك باقى الاعضاء الاخرين ملاحظة : باسورد نافذة الامان الافتراضى 12345 باسورد vba وقاعدة البيانات وفتح الملف 12345 لابد من تمكين الماكرو ليعمل الملف فى النهاية نسألكم الدعاء بظهر الغيب emp.rar

الملف مرة تانية بالمرفقات ودا الكود المتسخدم بالشرح On Error Resume Next If Range("a3") = "" Or Range("b3") = "" Or Range("c3") = "" Then MsgBox "bla bla1", vbDefaultButton1, "bla bla1 " Else azsh = Sheet2.Range("c50000").End(xlUp).Row + 1 Sheet1.Range("A3:C3").Copy Sheet2.Cells(azsh, 1).PasteSpecial Paste:=xlPasteValues MsgBox "bla bla2", vbDefaultButton1, "bla bla2 " Sheet1.Range("A3:C3") = "" End If كود ترحيل البيانات- أوفيسنا.rar

مرفق الحل ويمكن تعديل saudi riyal و halala Function SpellNumber(ByVal MyNumber, _ Optional pbNum As Boolean = True, _ Optional ptCur As String = "saudi riyal", _ Optional ptDec As String = "halala", _ Optional ptPlu As String = "") Dim Curr, Decm, Temp Dim DecimalPlace, Count Dim vtPHolder As String ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " '' String representation of amount MyNumber = Trim(Str(MyNumber)) '' Position of decimal place 0 if none DecimalPlace = InStr(MyNumber, ".") '' Convert decimal part, and set MyNumber to currency amount If DecimalPlace > 0 Then vtPHolder = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2) If pbNum = True Then Decm = GetTens(vtPHolder) Else Decm = vtPHolder End If MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp = GetHundreds(Right(MyNumber, 3)) If Temp <> "" Then Curr = Temp & Place(Count) & Curr If Len(MyNumber) > 3 Then MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop Select Case Curr Case "" Curr = "No " & ptCur & "" Case "One" Curr = "One " & ptCur Case Else Curr = Curr & " " & ptCur & "" End Select Select Case Decm Case "" Decm = " No " & ptDec & ptPlu Case "One", "01" Decm = " and " & Decm & " " & ptDec Case Else Decm = " and " & Decm & " " & ptDec & ptPlu End Select SpellNumber = Curr & Decm End Function '******************************************* ' Converts a number from 100-999 into text * '******************************************* Function GetHundreds(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) 'Convert the hundreds place If Mid(MyNumber, 1, 1) <> "0" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred " End If 'Convert the tens and ones place If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & GetTens(Mid(MyNumber, 2)) Else Result = Result & GetDigit(Mid(MyNumber, 3)) End If GetHundreds = Result End Function '********************************************* ' Converts a number from 10 to 99 into text. * '********************************************* Function GetTens(TensText) Dim Result As String Result = "" 'null out the temporary function value If Val(Left(TensText, 1)) = 1 Then 'If value between 10-19 Select Case Val(TensText) Case 10: Result = "Ten" Case 11: Result = "Eleven" Case 12: Result = "Twelve" Case 13: Result = "Thirteen" Case 14: Result = "Fourteen" Case 15: Result = "Fifteen" Case 16: Result = "Sixteen" Case 17: Result = "Seventeen" Case 18: Result = "Eighteen" Case 19: Result = "Nineteen" Case Else End Select Else 'If value between 20-99 Select Case Val(Left(TensText, 1)) Case 2: Result = "Twenty " Case 3: Result = "Thirty " Case 4: Result = "Forty " Case 5: Result = "Fifty " Case 6: Result = "Sixty " Case 7: Result = "Seventy " Case 8: Result = "Eighty " Case 9: Result = "Ninety " Case Else End Select Result = Result & GetDigit(Right(TensText, 1)) 'Retrieve ones place End If GetTens = Result End Function '******************************************* ' Converts a number from 1 to 9 into text. * '******************************************* Function GetDigit(Digit) Select Case Val(Digit) Case 1: GetDigit = "One" Case 2: GetDigit = "Two" Case 3: GetDigit = "Three" Case 4: GetDigit = "Four" Case 5: GetDigit = "Five" Case 6: GetDigit = "Six" Case 7: GetDigit = "Seven" Case 8: GetDigit = "Eight" Case 9: GetDigit = "Nine" Case Else: GetDigit = "" End Select End Function تفقيط انجليزي.rar

جزاك الله خيرا رحم الله والدك وأدخلة فسيح جناته

السلام عليكم ورحمة الله وبركاته ملف تجريبي ينتهى عند تاريخ معين مع طلب ترخيص كود التفعيل عبارة عن رقم المسلسل مضروب فى 3 يطرح منة 6789 ويمكن تغيير المعادلة من Sheet1 خلية B2 باسورد قاعد البيانات 12345 reg.rar

جرب FoxitReader