Alaaq3

أنا اعتذر منك استاذنا العزيز . شكراً لجهودك المحترمة

أُستاذنا العزيز عبد الفتاح... اجدد شكري وتقديري لحظرتك وأُقدر حرصك على المواضيع التي تُطرح في المنتدى. استاذنا لم اطلب مراجعة جميع أسطر المحرر بل اعتمدت على شكل اليوزر فورم من خلال الملف المرفق والصورة لذلك من البديهي إن خاصية وعمل أداة الـ checkbox هي اتخاذ إجراء وإلغاءه (check & Uncheck) أما عن المحاولات فإني حاولت كثيراً ولم افلح لذلك التجأت للاساتذة في هذا المنتدى. تحياتي

الاخ العزيز عبد الفتاح.. شكراً لمتابعتك مواضيع المنتدى بشكل دقيق ومجدي وقد اجبت عن موضوعي مشكوراً، كذلك انا رأيت توقيعك بعدم التعديل وتفهمت الموضوع ولم اطلب تعديلاً بناءً على توقيعك الموقر وقلت(اردتُ ان اطلب) وبالفعل لم اطلب هذا في الواقع . اما بخصوص تنويهك بإضافة كل تفاصيل الموضوع من البداية بدلاً من طلبات التعديل في كل مرة؟! اقول انا في البداية ارفقت الملف وفيه خاصية حذف العمود في حالة عدم التعليم على checkbox لذلك من البديهي أن اسأل عن هذه الخاصية طالما كانت موجودة مسبقاً. تحياتي 🌹

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

الغاية من الموضوع هو نسخ اعمدة محددة، وكذلك منعاً لبعثرة الشيت الاصلي عندما اجري عليه بعض العمليات مثل الفلترة والحذف وغيرها

السلام عليكم ورحمة الله وبركاته " اريد عندما اضغط على اي خيار من checkboxs يقوم بنسخ محتويات العمود الذي اخترته من الشيت الاول الى الشيت الثاني وهكذا بالتسلسل انتبه من فضلك .. مشاركة مكررة فقد تــــم بالفعل حذف المشاركة الأخرى check column.xlsm

احسنت اخي الكريم : جزاك الله الف خير

السلام عليكم ورحمة الله : احصائية.xlsmاريد احضائية بيانات تظهر على الفورم معرفة عدد الذكور ..عدد الاناث.. عدد الاذكور البالغين الموظفين .. عدد الذكور البالغين العاطلين ... عدد الذكور الاحداث الموظفين ... الخ احصائية.xlsm

شكرا لك اخي العزيز . جزاك الله الف خير

اخي الكريم ارفقت ملف ياريت تطلع عليه وتقوم بتعديله

لدي مشكلة في هذا الكود عندما اقوم باختيار الكل فأن البيانات تختفي Private Sub ComboBox1_Change() ActiveSheet.Range("B2").CurrentRegion.AutoFilter Field:=2, Criteria1:=ComboBox1.Value End Sub Private Sub UserForm_Initialize() ComboBox1.List = Array("الكل", "ذكر", "انثى") End Sub الجنس.xlsm

احسنت اخي العزيز . جزاك الله الف خير

كود حذف تنسيق الصفوف الاخيرة الفارغة ClearFormats Sheets("sheet1").UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats هذا الكود بحذف تنسيق الخلايا الفارغة اريد التعديل عليه ليقوم بحذف تنسيق الصفوف الفارغة بدل الخلايا الفارغة

ممكن كود يقوم بتحديد الخلايا التي تحتوي على نص في الشيت

تم حل الموضوع

الاساتذة الكرام : هذا الكود يقوم بفلترة البيانات من على (listbox) فقط في وضع الاختيار المفردة Single وعندما اقوم بتغيير خصائص الـ listbox الى خيارات متعددة فأن الفلترة تتوقف . ارجو المساعد. المرفقات: الفورم vba صورة الفورم فلترة متعددة.xlsm

السلام عليكم . الاساتذة الاعزاء شاهدت فيديو لشخص يقوم بفتح كاميرا ويب من خلال اليوزرفورم عن طريق اداة موجودة في التول بوكس اسمها (VedioCap) وسأقوم بارفاق الملف الموجود في الشرح مع صورة توضيحية للاداة (VedioCap) . كيف لي ان اقوم بعمل ذلك ؟ Capture Photo in Excel.xlsm

احسنتم جميعاً. جزاكم الله الف خير

السلام عليكم .كيفية التحكم في الشيت وتعديله مع ان الفورم يكون ظاهراً

شكراً اخي العزيز : الكود رائع واستفدت منه كثيرا. ولكن انا اريد ان اكتب صيغة الكسور ( النصف او الثلث او الربع) . مثلاً هذا الكود الي بالاسفل يقوم بانقاص 45 يوم من كل 6 اشهر (اي الربع) . ما اريده هو كتابة (ComboBox3 * -1.5) مثلا TextBox3.Value = Format(DateAdd("d", (ComboBox3 * -45), TextBox2), "YYYY/MM/DD") توضيح اكثر : مثلا اريد ان اقوم بإنقاص الربع او النصف او الثلث من الـ 7 اشهر

كيف اعبر عن انقاص الكسور من تاريخ معين (مثال: بدل ان اكتب (- ٤٥ يوم) اكتب بدل عنها "شهر ونصف" ) او اكتب انقاص ثلث التاريخ او ربع التاريخ DateAdd("d", (Val(TextBox4) * -45)

احسنتم كثيرا كيلا الطريقتان نجحتا

جزاك الله الف خير أستاذ محمد صالح .الكود يعمل باحسن ما يكون . ولكن هل بالامكان اضافة شرطاً ثالث ؟! بمعنى ( اذا كانت السنوات اكبر اويساوي (1) و الشهور اكبر او يساوي (6) يتم انقاص (3)شهر من كل سنة و (45) يوم من كل 6 اشهر فما فوق . كذلك (الشرط الثالث) اذا كانت الشهور ((أكبر)) من 6 يتم انقاص (45) يوم حتى وان كانت السنوات قيمتها 0 --------- بصراحة حاولت كثيرا والنتيجة تكون غير صحيحة الكود قام بانقاص 45 يوم لمرتين اي 3 اشهر !!! تحياتي لك استاذ محمد وشكراً من القلب لك

السلام عليكم الاستاذة الكرام : هذا الكود يقوم بانقاص 3 اشهر من كل سنة . اريد اضافة كود يقوم بانقاص (شهر ونص) من كل 6 اشهر TextBox3 = DateAdd("m", (Val(TextBox4) * -3), TextBox2) الان اريد انقاص شهر ونصف من كل 6 اشهر فما فوق من خانة TextBox5 الخاصة بالشهور بشرط ان تكون خانة TextBox4 الخاصة بالسنوات قيمتها اكثر من 0 توضيح/// . يتم انقاص (الشهر والنصف) من خانة الشهور مشروطة بشرطين: الاول ان تكون قيمتها اكبر او تساوي 6 . والشرط الثاني ان تكون في خانة السنوات قيمة اكثر او يساوي سنة حساب وجمع التواريخ (1).xlsm

السلام عليكم ورحمة الله : الاساتذة الكرام ارجو المساعدة في موضوع حفظ مكان الصور . هذا الفورم المرفق يقوم بحفظ الصور بجانب ملف الاكسل . وانا اريد ان يحفظها في مكان اخر مثلا ( ملف الاكسل على سطح المكتب والصور في قرص /:E) بيان الموظفين.xlsm Private Sub CommandButton1_Click() Unload Me End Sub Private Sub CommandButton2_Click() image_path = Application.GetOpenFilename(FileFilter:="Picture Files (Fichiers image),*.gif;*.jpg;*.jpeg;*.bmp", Title:="اختار الصورة") If image_path <> False Then Me.Image1.Picture = LoadPicture(image_path) Me.Image1.Visible = True End If End Sub Private Sub CommandButton3_Click() If TextBox2.Value = "" Then MsgBox "ادخل اسم الصورة اولا": Exit Sub Var = TextBox2.Text مكان حفظ الصور ' SavePicture Image1.Picture, ThisWorkbook.Path & "\" & Var & ".jpg" MsgBox "تم حفظ الصورة بنجاح مع تحيات مجدى يونس", vbInformation End Sub Private Sub Image1_Click() End Sub Private Sub TextBox1_Change() '============================= Dim MYPATH MYPATH = ThisWorkbook.Path & "\" & TextBox1.Text & ".JPG" If Right(MYPATH, 1) <> "\" Then On Error GoTo 1 Image1.Picture = LoadPicture(MYPATH) Else 1: 'MsgBox "هذا الصورة غير موجودة", vbInformation, "خطأ" 'Image1.Picture = LoadPicture() Image1.Picture = LoadPicture(ThisWorkbook.Path & "\M.JPG") Exit Sub End If '========================================== End Sub Private Sub TextBox2_Change() End Sub Private Sub UserForm_Click() End Sub Private Sub Yh_ListFind_Click() On Error Resume Next Dim MYSH As Worksheet Dim S_1 As String S_1 = Yh_ListFind.List(Yh_ListFind.ListIndex, 6) Set MYSH = Sheets("new") With MYSH .Select .Range(S_1).Select End With TextBox1.Value = Range(S_1).Value End Sub Private Sub Yh_ListFind_DblClick(ByVal cancel As MSForms.ReturnBoolean) On Error Resume Next Dim MYSH As Worksheet Dim S_1 As String S_1 = Yh_ListFind.List(Yh_ListFind.ListIndex, 6) Set MYSH = Sheets("new") With MYSH .Select .Range(S_1).Select End With Me.Hide End Sub Private Sub Yh_TextFind_Change() On Error Resume Next Dim MYSH As Worksheet Dim V As Integer, LastRow As Integer Dim M As String Dim A, F Yh_ListFind.Clear If Yh_TextFind.Text = "" Then GoTo 1 M = Yh_TextFind.Text Set MYSH = Sheets("new") With MYSH LastRow = .Cells(.Rows.Count, "d").End(xlUp).Row Set A = .Range("d13:d" & LastRow).Find(M) If Not A Is Nothing Then F = A.Address Do If Application.WorksheetFunction.Search(M, A, 1) = 1 Then Yh_ListFind.AddItem A.Value Yh_ListFind.List(V, 1) = A.Offset(0, 1).Value Yh_ListFind.List(V, 2) = A.Offset(0, 2).Value Yh_ListFind.List(V, 3) = A.Offset(0, 3).Value Yh_ListFind.List(V, 4) = A.Offset(0, 4).Value Yh_ListFind.List(V, 5) = A.Offset(0, 5).Value Yh_ListFind.List(V, 6) = A.Address V = V + 1 End If Set A = .Range("d13:d" & LastRow).FindNext(A) Loop While Not A Is Nothing And A.Address <> F End If End With On Error GoTo 0 1 End Sub