نجوم المشاركات

يمكنك اخي بجعل الكود بهده الطريقة 'حيث يتم اظهار الرسالة فقط عند كتابة اسم محمد او سعيد فقط Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 And Target.Row > 1 Then If (Target.Offset(0, 2).Value = "") And ((Target.Value = "محمد") Or (Target.Value = "سعيد")) Then MsgBox "تاكد من مركز التكلفة " Target.Offset(0, 2).Select End If End If End Sub رسالة.xlsm

يمكنك اخي دالك بجعل الكود بهده الطريقة Sub Undo_add_change() Dim Sheet As Worksheet Dim liste1 As Variant Dim liste2 As Variant Dim MH As Long Dim Rng As Range Set Sheet = Sheets("سجل وسط نهاية السنة") Set Rng = Range("D6:L45") Application.ScreenUpdating = False For i = 6 To 45 liste1 = Array("49.5 50", "49 50", "48.5 50", "48 50", "47.5 50", "47 50", "46.5 50", "46 50", "45.5 50", "45 50") liste2 = Array("49.5", "49", "48.5", "48", "47.5", "47", "46.5", "46", "45.5", "45") For MH = LBound(liste1) To UBound(liste1) If Range("R" & i).Value = "راسب" Then Range("d" & i, "k" & i).Cells.Replace What:=liste1(MH), Replacement:=liste2(MH), _ LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, _ SearchFormat:=True, ReplaceFormat:=True Rng.Font.Size = 11 Rng.Font.Name = "Arial" If Range("R" & i).Value = "راسب" Then Range("d" & i, "k" & i).Cells.Font.Strikethrough = False End If End If Next MH Next i Application.ScreenUpdating = True End Sub تراجع_2.xlsm

وعليكم السلام ..بما انك لم تقم برفع ملف ,,فكان عليك استخدام خاصية البحث بالمنتدى فطلبك تكرر كثير جداً وشوف بنفسك : وده كمان مثال بملف مرفق لك وكلمة السر لإظهار الصفحات : 123 اخفاء الشيتات و ترك الشيت الرئيسي هو الظاهر كود اخفاء الشيتات عدا شيت محدد اخفاء الصفحات تلقائيا اخفاء أوراق العمل وعدم اظهارها فورم_كود اظهار و اخفاء للصفحات Sheets Hidding - 2.xlsm

أستاذى @Barna جزاك الله خيراً و يمكن التحديد بالشهر مباشرةً

طيب جرب المرفق التالي بعد التعديل ....... test print.mdb

جرب المرفق ........ واكتب التاريخ في مربع النص كاملا .... مثلا ( 2014/03/22 ) والبرنامج يقوم بالمطلوب . test print.mdb

وجدت لك مثالا في مكتبتي يظهر تاريخ الانترنت في مصر ( مكتبتي تشمل امثلة كثيرة معظمها ليست من عملي) سوف تلاحظ بطء عند تشغيل النموذج وهذا بسبب جلب التاريخ من الموقع المخصص يحتاج لهذا الوقت حسب سرعة الانترنت هذه هي الوحدة النمطية الاصلية .. فقط غيرت رابط الموقع فيها Function InternetTime(Optional GMTDifference As Integer) As Date '----------------------------------------------------------------------------------- 'This function returns the Greenwich Mean Time retrieved from an internet server. 'You can use the optional argument GMTDifference in order to add (or subtract) 'an hour from the GMT time. For Example if you call the function as: '=InternetTIme(2) it will return the (local) hour GMT + 2. Note that the 'GMTDifference variable is an integer number. 'Written by: Christos Samaras 'Date: 25/09/2013 'Last Updated: 20/11/2013 'e-mail: xristos.samaras@gmail.com 'site: http://www.myengineeringworld.net 'Declaring the necessary variables. Dim Request As Object Dim ServerURL As String Dim Results As String Dim NetDate As String Dim NetTime As Date Dim LocalDate As Date Dim LocalTime As Date 'Check if the time difference is within the accepted range. If GMTDifference < -12 Or GMTDifference > 14 Then Exit Function End If 'The server address. ServerURL = "https://www.time.gov/" 'ServerURL = "http://www.timeanddate.com/worldclock/fullscreen.html?n=2" 'Build the XMLHTTP object and check if was created successfully. On Error Resume Next Set Request = CreateObject("Microsoft.XMLHTTP") If Err.Number <> 0 Then Exit Function End If On Error GoTo 0 'Create the request. Request.Open "GET", ServerURL, False, "", "" 'Send the request to the internet server. Request.Send 'Based on the status node result, proceed accordingly. If Request.readyState = 4 Then 'If the request succeed, the following line will return 'something like this: Mon, 30 Sep 2013 18:33:23 GMT. Results = Request.getResponseHeader("date") 'Use the Mid function to get something like: 30 Sep 2013 18:33:23. Results = Mid(Results, 6, Len(Results) - 9) 'Use the Left and Right function to distinguish the date and time. NetDate = Left(Results, Len(Results) - 9) '30 Sep 2013 NetTime = Right(Results, 8) '18:33:23 'Convert the date into a valid Excel date 30 Sep 2013 -> 30/9/2013. 'Required for countries that have some non-Latin characters at their alphabet (Greece, Russia, Serbia etc.). LocalDate = ConvertDate(NetDate) 'Add the hour difference to the retrieved GMT time. LocalTime = NetTime + GMTDifference / 24 'Return the local date and time. InternetTime = LocalDate + LocalTime End If 'Release the XMLHTTP object. Set Request = Nothing End Function Function ConvertDate(strDate As String) As Date '------------------------------------------------------------------------- 'This function converts the input date into a valid Excel date. 'For example the 30 Sep 2013 becomes 30/9/2013. 'Required for countries that have non-Latin characters at their alphabet. 'Written by: Christos Samaras 'Date: 25/09/2013 'e-mail: xristos.samaras@gmail.com 'site: http://www.myengineeringworld.net '------------------------------------------------------------------------- 'Declaring the necessary variables. Dim MyMonth As Integer 'Check the month and convert it to number. Select Case UCase(Mid(strDate, 4, 3)) Case "JAN": MyMonth = 1 Case "FEB": MyMonth = 2 Case "MAR": MyMonth = 3 Case "APR": MyMonth = 4 Case "MAY": MyMonth = 5 Case "JUN": MyMonth = 6 Case "JUL": MyMonth = 7 Case "AUG": MyMonth = 8 Case "SEP": MyMonth = 9 Case "OCT": MyMonth = 10 Case "NOV": MyMonth = 11 Case "DEC": MyMonth = 12 End Select 'Rebuild the date. ConvertDate = DateValue(Right(strDate, 4) & "/" & MyMonth & "/" & Left(strDate, 2)) End Function وهذا هي الاكواد الخاصة بمنادات الدالة في النموذج Private Declare Function InternetGetConnectedState Lib _ "wininet" (ByRef dwflags As Long, ByVal dwReserved As _ Long) As Long Private Sub Form_Load() If InternetGetConnectedState(0, 0) = 1 Then lblResult.Caption = "Connected" Else lblResult.Caption = "Not Connected" End If End Sub وهذا السطر يوضع في مصدر تحكم الحقل .. لاحظ الرقم يتغير حسب المنطقة فلو اردت تطبيق النموذج على السعودية فيجب تغيير الرقم 2 الى الرقم 3 =InternetTime(2) وهذا تنسيق لاظهار الوقت فقط في مصدر تحكم الحقل =Format(InternetTime(2);"hh:nn:ss AM/PM") تاريخ ووقت الانترنت.rar

تفضلي اختي الفاضلة Invoices-j.xlsm

=IF(1*TEXT(EOMONTH(TODAY();0);"dd")>30;EOMONTH(TODAY();0)-21-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=30;EOMONTH(TODAY();0)-20-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=29;EOMONTH(TODAY();0)-19-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=28;EOMONTH(TODAY();0)-18-TODAY()&"يوم"))))

اخي الكريم مبرمج متقاعد شكراً لتعبك هذا هو المطلوب جعله الله في ميزان حسناتك

لاحظ انه تم اضافة مقطع رأس لجهة العمل ، وقمت انا بنقل الحقل اليه طبعا اكسس يضيفه بمجرد اختيارك لنوع التجميع

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

السلام عليكم ورحمة الله تعالى وبركاته تفضل اخي هدا كود للتراجع فقط عن الدرجات المضافة للطالب الراسب. Sub Undo_add_change() Dim Sheet As Worksheet Dim liste1 As Variant Dim liste2 As Variant Dim MH As Long Dim Rng As Range Set Sheet = Sheets("سجل وسط نهاية السنة") Set Rng = Range("d6:L45") Application.ScreenUpdating = False For i = 6 To 45 liste1 = Array("49.5 50", "49 50", "48.5 50", "48 50", "47.5 50", "47 50", "46.5 50", "46 50", "45.5 50", "45 50") liste2 = Array("49.5", "49", "48.5", "48", "47.5", "47", "46.5", "46", "45.5", "45") For MH = LBound(liste1) To UBound(liste1) If Range("R" & i).Value = "راسب" Then Range("d" & i, "k" & i).Cells.Replace What:=liste1(MH), Replacement:=liste2(MH), _ LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, _ SearchFormat:=True, ReplaceFormat:=True End If Next MH Next i With Sheets("سجل وسط نهاية السنة") Rng.Font.Size = 11 Rng.Font.Name = "Arial" Rng.Font.Strikethrough = False End With Range("M3").Select Application.ScreenUpdating = True End Sub وهدا كود لاضافة درجات القرار : Sub Add_Resolution_2() Dim i As Long Dim MH As Long, k As Long Application.ScreenUpdating = False With Sheets("سجل وسط نهاية السنة") lrow = .Cells(Rows.Count, 32).End(xlUp).Row liste1 = Split("AF,AG,AH,AI,AJ,AK,AL,AM,AN, AO, AP, AQ, AR", ",") liste2 = Split("D,E,F,G,H,i,j,k,L,M,N,O,P", ",") For i = LBound(liste1) To UBound(liste1) .Range(liste1(i) & "6:" & liste1(i) & lrow).Copy Sheets("سجل وسط نهاية السنة").Range(liste2(i) & "6") Application.ScreenUpdating = True Next i End With End Sub تراجع_2.xlsm

هذا هو الموجود فعلا على الملف عند كتابة رقم الوصل يتم جلب بياناته من ورقة transaction قد تم وضع القائمة للتجربة فقط Imprimer-3.xlsm

السلام عليكم و رحمة الله اجعل الكود هكذا Sub y() Dim sumRange As Range, criteriaRange As Range Dim result As Double Dim i As Integer Dim lastrow As Long Dim R As Range Dim criteria As Variant Set criteriaRange = Range("D4:D20") criteria = Array("اجمالي صنف1", "اجمالي صنف2") j = 1 Do While j <= 6 Set sumRange = Range("E4:E20").Offset(0, j - 1) For i = 0 To UBound(criteria) result = WorksheetFunction.Sum(result, WorksheetFunction.SumIfs(sumRange, criteriaRange, criteria(i))) Set R = ActiveSheet.Cells.Find("اجمالي الأصناف", , xlValues, xlWhole) If Not R Is Nothing Then R.Select ActiveCell.Offset(0, j).Select ActiveCell.Value = result Next i result = 0 j = j + 1 Loop Range("D3").Activate End Sub

السلام عليكم إخوتي الكرام بعد إذن الأخ الكريم الذي وصل إلى النتيجة ، إليكم طريقة أخرى بمعادلة واحدة فقط =IF(1*TEXT(EOMONTH(TODAY();0);"dd")>30;EOMONTH(TODAY();0)-4-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=30;EOMONTH(TODAY();0)-3-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=29;EOMONTH(TODAY();0)-2-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=28;EOMONTH(TODAY();0)-1-TODAY()&"يوم")))) وهناك معادلة أخرى فقط للملاحظة قد لا يحتاجها الأخ السائل: =" باقي"&$C$5&" "&"بناء على تاريخ نزول الراتب والذي يوافق يوم 27 من كل شهر ميلادي" والله ولي التوفيق ..والسلام عليكم موعد الرواتب.xlsx

السلام عليكم ..تفضل اخي الكريم ما عليك فقط غير ان اول خانه تكتب رقم الشهر فقط و الخانة الثانية في التاريخ تذكر اول يوم من اول تاريخ في السنه الحالية ..تحياتي ♥ موعد الرواتب.xlsx

وعليكم السلام أهلاً بك فى المنتدى -تفضل لك ما طلبت ويجب عليك اتباع الخطوات كما بالصورة حدود الصفحة.xlsm

وعليكم السلام -تفضل بهذه المعادلة سحباً لليسار ثم الى الأسفل =COUNTIFS(data!C$2:C$1000,"<>"&"",data!$A$2:$A$1000,$B4,data!$B$2:$B$1000,1) trasnport1.xlsx

فقط يمكنك استخدام هذه المعادلة أو بعمل تنسيق للخلايا بأن يكون تنسيق الخلية يوم وليس تاريخ B2dddd =TEXT(B3,"b2dddd") هاجر البصمة1.xlsx

برنامج barcode2win ممتاز وعن تجربة للاسخدام من ال QRcode ولكن مع الباركود الخطي به اخطاء ولازم جهاز ليزر

اعتقد من الوهلة الاولى ... كل ما تحتاجة فقط برنامج للربط بين الحاسوب والموبايل

انا لله وانا اليه راجعون لله ما اعطى وما اخد Speed Test

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

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

يمكنك الاستفادة من هذا الموضوع هنا فيه الموضوع الاصلي للبرنامج

السلام عليكم برنامج صغير للديون الشخصية وسدادها مفتوح المصدر لامكانية التعديل عليه اتفضلوا يهمني سماع رأيكم الديون .accdb

السلام عليكم ورحمة الله وبركاته أقدم لكم اليوم برنامج لتسجيل بيانات أجازات الموظفين -بارك الله فيكم ..الباسورد: 123 برنامج اجازات الموظفين.xlsm

اخوانى الكرام الملف يعمل عندى وهذه صورة الواجهة وسأرسل الملف مرة اخرى برنامج اجازات الموظفين.xlsm

السلام عليكم أهل المنتدى الكرام أقدم اليكم اليوم برنامج متخصص فى الفواتير والمخازن يارب يعجبكم ..بارك الله فيكم وغفر لكم takala-برنامج المحاسب العربى.rar

بارك الله فيك استاذ سليم ولإثراء الموضوع هذا الملف به طريقتين , التقسيم بالمعادلات وايضا صفحة اخرى بالكود تقسيم الأرقام.xls

تفضل أخى علاء هذا البرنامج برنامج حساب مكافأة الامتحانات لغير النقابيين من اعداد الاستاذ محمد عبدالله.xls

أخى معادلة أستاذنا سليم تعمل بكل بكفاءة لعلك غفلت أو نسيت أن تضغط على Ctrl+Shift+Enter فهى معادلة مصفوفة ولكم جزيل الشكر

وعليكم السلام استاذنا القدير سليم زادك الله من علمه وجعله فى ميزان حسناتك وبارك الله فيك

وعليكم السلام لقد تم الحل من قبل استاذنا الكبير ياسر خليل فورمة بحث في الشيتات - اظهار المراحل لاختصار طبع الفاتورة.xlsm

تفضل أخى لقد تم الحل من قبل الأستاذ محمد الدسوقى-له منه كل المحبة والسلام بارك الله فيه نموذج إدخال2 بيانات 2010 .rar

أهلا وسهلا بكى فى منتدانا الكريم تفضل ممكن تقومى بتحميله من هذا الموقع : https://microsoft-office-2010.ar.softonic.com/download أو من هذا https://www.programsdownloader.com/microsoft-office-2010-full-free/