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

Ali Mohamed Ali

المشرفين السابقين
  • Posts

    11638
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    291

كل منشورات العضو Ali Mohamed Ali

  1. وعليكم السلام-يجب عليك جعل الكود هكذا .. وحاول معرفة الفرق البسيط والإضافة السهلة بين كودك وهذا الكود بارك الله فيك Private Sub CommandButton1_Click() Dim Lrow As Integer Lrow = Sheets("data").Range("b10000").End(xlUp).Row + 1 Sheets("data").Cells(Lrow, "b").Value = Sheets("fan").Range("d5").Value Sheets("data").Cells(Lrow, "C").Value = Sheets("fan").Range("D7").Value Sheets("data").Cells(Lrow, "D").Value = IIf(OptionButton1.Value = True, "ذكر", "انثى") Sheets("data").Cells(Lrow, "E").Value = Sheets("fan").Range("D11").Value Sheets("data").Cells(Lrow, "F").Value = Sheets("fan").Range("D13").Value Sheets("data").Cells(Lrow, "G").Value = Sheets("fan").Range("D15").Value Sheets("data").Cells(Lrow, "H").Value = Sheets("fan").Range("G7").Value Sheets("data").Cells(Lrow, "I").Value = Sheets("fan").Range("G9").Value Sheets("data").Cells(Lrow, "J").Value = Sheets("fan").Range("G11").Value Sheets("data").Cells(Lrow, "K").Value = Sheets("fan").Range("G13").Value MsgBox "تم اضافة البيانات بنجاح", vbInformation, "تأكيد" Sheets("fan").Range("D5").Value = "" Sheets("fan").Range("D7").Value = "" Sheets("fan").Range("D11").Value = "" Sheets("fan").Range("D13").Value = "" Sheets("fan").Range("D15").Value = "" Sheets("fan").Range("G7").Value = "" Sheets("fan").Range("G9").Value = "" Sheets("fan").Range("G11").Value = "" Sheets("fan").Range("G13").Value = "" OptionButton1.Value = "" OptionButton2.Value = "" End Sub forms1.xlsm
  2. بارك الله فيك استاذ حسين _ بعد اذنك ولإثراء الموضوع .. على ان يكون ايضاً الكود بهذا الشكل Private Sub CommandButton1_Click() If UserForm1.TextBox1.Value = "admin" And UserForm1.TextBox2.Value = 2020 Or UserForm1.TextBox1.Value = "ali" And UserForm1.TextBox2.Value = 456 Then Application.Visible = True UserForm1.Hide If UserForm1.TextBox1.Value = "admin" And UserForm1.TextBox2.Value = 2020 Then Sheet5.Select End If If UserForm1.TextBox1.Value = "ali" And UserForm1.TextBox2.Value = 456 Then Sheet1.Select End If Else MsgBox "بـرجاء مراجـعـة اســم المستخدم وكلمـة المـرور", , "Error" Label4.Caption = Label4.Caption - 1 If Label4.Caption = 0 Then ThisWorkbook.save Application.Quit End If End If End Sub شيت فاتورة مبيعات .xlsm
  3. بعد اذن استاذ أحمد زمان طبعاً ...يمكنك استخدام هذا الكود فى حدث الصفحة لتكبير حجم الخط فى القائمة المنسدلة وأعتقد ان هذا يكفى فى هذه المشاركة فيجب الغلق فمن الطبيعى والمفترض ان تكون المشاركة لطلب واحد بارك الله فيكم Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo Skipper Dim x As Long x = 100 If Target.Validation.Type = xlValidateList Then x = 130 Skipper: ActiveWindow.Zoom = x End Sub _البرنامج 1-7-2020 - نسخة (2) (1).xls
  4. طبعاً بعد اذن استاذنا الكبير سليم ... اخى الكريم bander22122 , الهدف الأساسى من المنتدى هو محاولة التعلم وليس اخذ المعلومة على الجاهز بدون الإستفادة والتعلم حتى يأتى لك يوم تفيد من يحتاج الى مساعدتك كما تم تقديم المساعدات لك من قبل اساتذتنا الكبار الأمر ليس صعب بل هم بسيط للغاية ويمكنك عمل ذلك بنفسك وكما أخبرك استاذنا الكريم سليم فقط عليك تغيير الرقم 100 الى اى رقم تريد فليكن 900 وبعد التعديل فى كل مواضع المعادلة .. عليك العلم بأن هذه ليست معادلة عادية بل هى معادلة مصفوفة .. اى بعد الإنتهاء من تغيير كل رقم 100 الى الرقم الذى تريده عليك بالضعط على ( Ctrl+Shift+Enter ) فلابد من ظهور الأقواس بهذه الطريقة بالمعادلة بعد هذه الخطوة {} وليس Enter فقط كباقى المعادلات وهذا هو السبب فى انك لم تستطع ضبط المعادلة ... وشكرا واسفغ على الإطالة
  5. تفضل لك ما طلبت .. تم عمل كل المطلوب من فصل للقروش عن الجنيهات وتم عمل وتصميم معادلة الإستقطاعات وتطبيق كل هذا على الجداول 1حصر تالف.xlsx
  6. رجاءاً اخى الكريم تجنباً لعدم اهدار وقت الأساتذة فى الرد على مشاركات مكررة وتم تناولها كثيراً بالمنتدى ... فعليك بإستخدام خاصية البحث بالمنتدى قبل رفع اى مشاركة جديدة فربما تجد ما تريد بالمنتدى فبالتالى ليس هناك اى داعى لرفع هذه المشاركة -تفضل الموضوع هنا تم نقاشه سابقاص بالمنتدى طريقة لعمل فرز مع وجود حماية للورقة واضافة الى ذلك تفضل فيديو للأستاذ عماد غازى لشرح هذا الطلب اكسل vba كيفية فرزوفلترة البيانات مع حماية ورقة العمل بباسورد autofilter excel
  7. مبارك الترقية استاذ صالح وان شاء الله تكون على قدر هذه المسؤلية العظيمة .... ونتمنى لكم النجاح والتفوق دائماً
  8. تفضل يمكنك جعل المعادلة هكذا ... وتم عمل أيضاً تنسيق شرطى للخلية اذا كان بها كلمة مغادرة =IF(G$7=$D8,"مغادرة",IF(AND(G$7>=$C8,G$7<=$D8-1),$E8,0)) If Function.xlsx
  9. كان عليك استخدام خاصية البحث بالمنتدى -تفضل دالة جميلة للترجمة من الانجليزية الى لغات العالم
  10. جرب هكذا وهناك ايضا فيديو لشرح عملية التحويل للأستاذة ساجدة العزاوى لها منا كل الإحترام ج100 كيف نجعل كود 32 بت يعمل على 64 بت وعدم ظهور خطأ ptrsafe اكسل vba ساجدة العزاوي تحويل64بيت.xlsb
  11. وعليكم السلام- استبدل معادلتك الشرطية بهذه المعادلة =IF(AND($C6<>"",$C6<>0),CHOOSE($C6,"-","-","15","45","85","125","165"),"") أما بالنسبة للصفحة التى لا تحتوى على هذه المعادلة الشرطية (P 41 - Monolo) فيمكنك جعل تنسيق الخلايا بها كما بالصورة ... وشكراً 1 Drivers Over Time Summary1.xlsx
  12. أعمال ممتازة استاذ أحمد جزاك الله كل خير
  13. بارك الله فيك استاذ محي ولإثراء الموضوع يمكنك استخدام هذه المعادلة المعرفة وهذا هو كودها Function Evals(t As String) As Double Dim c As String, i As Long For i = 1 To Len(t) If Asc(Mid(t, i, 1)) < 58 And Asc(Mid(t, i, 1)) > 41 Then c = c & Mid(t, i, 1) Next Evals = Evaluate(c) End Function ثم تكتب المعادلة بالخلية B2 على النحو التالى : =Evals(A2) سليم1.xlsm
  14. وعليكم السلام يمكنك هذا ,بوضع ذلك الكود بحدث الصفحة Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("d:d")) Is Nothing Then Range("d1").Sort Key1:=Range("d2"), _ Order1:=xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End If End Sub فرز حسب 1الاكبر.xlsm
  15. من فضلك عليك الإنتباه من هذه الأخطاء ... فهذا الخطأ منك انت لأنك قمت بذكر صفحة Data بأكواد الفورم على الرغم انها غير موجودة بالملف المرفوع فعندما قمت بإضافة هذه الصفحة تم ظهور الفورم بكل كفاءة حل مشكلة1.xlsm
  16. من فضلك اخى الكريم لا تبخل بنجاح المشاركة فليس هناك وجود لأى مشاركة الا بعد تدعيمها بملف مشروح فيه كل المطلوب بكل دقة والا فكان عليك لزاماً استخدام خاصية البحث بالمنتدى قبل رفع هذه المشاركة طالما انك لم تقم برفع ملف !!! ولا تقول ان المشاركة بسيطة لا تحتاج لكل هذا ... فان كان طلبك بسيط لأستطعت انت بنفسك حله ولا احتجت لمساعدة الأخرين فى حل مشكلتك وتفريج كربتك تفضل هذا الكود Sub Unhide_All_Sheets() Dim ws As Worksheet ActiveWorkbook.Unprotect For Each ws In Worksheets ws.Visible = xlSheetVisible Next End Sub وهذا كود أخر Sub Unhide_All_Sheets_Count() Dim wks As Worksheet Dim count As Integer count = 0 For Each wks In ActiveWorkbook.Worksheets If wks.Visible <> xlSheetVisible Then wks.Visible = xlSheetVisible count = count + 1 End If Next wks If count > 0 Then MsgBox count & " worksheets have been unhidden.", vbOKOnly, "Unhiding worksheets" Else MsgBox "No hidden worksheets have been found.", vbOKOnly, "Unhiding worksheets" End If End Sub وهذا كود ثالث Sub Unhide_Selected_Sheets() Dim wks As Worksheet Dim MsgResult As VbMsgBoxResult For Each wks In ActiveWorkbook.Worksheets If wks.Visible = xlSheetHidden Then MsgResult = MsgBox("Unhide sheet " & wks.Name & "?", vbYesNo, "Unhiding worksheets") If MsgResult = vbYes Then wks.Visible = xlSheetVisible End If Next End Sub وهذا كود رابع Sub Unhide_Sheets_Contain() Dim wks As Worksheet Dim count As Integer count = 0 For Each wks In ActiveWorkbook.Worksheets If (wks.Visible <> xlSheetVisible) And (InStr(wks.Name, "report") > 0) Then wks.Visible = xlSheetVisible count = count + 1 End If Next wks If count > 0 Then MsgBox count & " worksheets have been unhidden.", vbOKOnly, "Unhiding worksheets" Else MsgBox "No hidden worksheets with the specified name have been found.", vbOKOnly, "Unhiding worksheets" End If End Sub اختر منهم ما يناسبك عرفت ان كده اهدار للوقت لأنك لم تقم من البداية برفع الملف فالخطأ عندك ,فالملف لم تقم بوضع اى كود به-تفضل بعد وضع الكود يعمل بكل كفاءة مثال.xlsm
  17. تفضل -يمكنك استخدام هذه المعادلة =COUNTIFS($B$4:$B$28,I$4,$C$4:$C$28,"*"&$H5&"*") SAME1.xlsx
  18. أخى الكريم انا لم أحذف شيئاً من ملفك فقط قمت بعمل ما تريد وهو ظهور أسماء الزبائن بدون تكرار بالقائمة المنسدلة وشكراً على تأخر ردك
  19. وعليكم السلام -يمكنك استخدام هذه المعادلة لذلك ... وأيضاً بالملف يوجد أربعة معادلات أخرى =LOOKUP(1,0/('1'!$A$3:$A$600=$A3)/('1'!$B$3:$B$600=$B3),'1'!$C$3:$C$600) test match price1.xlsx
  20. وعليكم السلام-لكى يتحقق ما تريد عليك بإستخدام هذه المعادلة =(INT(A2)+(A2-INT(A2))*100/60)*C2 الأضافى1.xls
  21. وعليكم السلام-لك ما طلبت test search1.xlsx
×
×
  • اضف...

Important Information