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

هذا برنامج جديد برنامج رسوم الطلاب.pdf برنامج رسوم الطلاب.xlsm

ارفق لك طريقة ليست عملية لكن قد تفيد في بعض الاحيان وربما يطورها اخرون نستطيع ان نسميها صناعة ال Chart بالطرق المحلية 😄 Graph.accdb

يمكنك استعمال هذا الكود في حدث عند التغيير Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 8 And Target.Row < 17 And Target.Column = 5 Then Dim C As Range, a As Boolean, b As Boolean For Each C In Range("E9:E16") If InStr(C.Value, "Positive") And (C.Row = 13 Or C.Row = 14) Then If Not a Then Range("C13").Value = "Titer250": a = True End If If InStr(C.Value, "+") Or InStr(C.Value, "yes") Then If Not b Then Range("C10").Value = "Positive": b = True End If Next C If Not a Then Range("C13").Value = "Nil" If Not b Then Range("C10").Value = "Negative" End If End Sub بالتوفيق

ماشاء الله لا قوة إلا بالله مهندس وظيفيا و وصفيا هذا عمل هندسي احترافي بكل ما تعنيه الكلمة

يمكنك استعمال الدالة val لتحصل على القيمة Range("e" & lrow).Value = Val(TextBox1.Value) Range("f" & lrow).Value = Val(TextBox2.Value) Range("g" & lrow).Value = Val(TextBox3.Value) بالتوفيق

تفضل هذه جرب هذه المعادلة ينتهي اليوم في الساعة 8 ص اليوم التاريخ 27 يكون التاريخ 27 بعد الساعة 8 ص و قبل الساعة 8 ص يكون التاريخ 26 IIf(Format(Now();"h")<=8;Format(DateAdd("d";-1;Now());"yyyy/mm/dd");Format(Now();"yyyy/mm/dd"))

استاذي العزيز .. اعتقد بانه يريد على قاعدة موزعة على عدد من المستخدمين بان المستخدم لاتظهر له البيانات بعد الساعة الثامنة مساء

إن شاء الله يفيدك هذا الموضوع بالتوفيق

انظر الان.. المدخلات عن طريق النموذج .. والجدول يأخذ الارقام فقط stu- up.accdb

جزاك الله خيرا استاذنا

تفضل أخي الكريم هذا اللغز من أفضل الألغاز التي قابلتها حيث استمرت المحاولات فيه يومين والحمد لله تم إنجازه إن شاء الله هذا الكود يقوم باللازم Sub mas_generateMsg() Dim SumH(1000) As Variant, SumV(1000) As Variant For i = 17 To Sheet3.Cells(Rows.Count, 5).End(xlUp).Row msg = "": frst = True: fw = Sheet3.Cells(i, 8) msg = msg & "عند خروج الفاتوره رقم " & Sheet3.Cells(i, 5) & " بتاريخ " & Format(Sheet3.Cells(i, 6), "yyyy/mm/dd") For c = 17 To Sheet2.Cells(Rows.Count, 6).End(xlUp).Row lw = Sheet2.Cells(c, 9) lot = IIf(fw - SumH(i) > lw, lw, fw - SumH(i)) mylot = IIf(lw - SumV(c) > lot, lot, lw - SumV(c)) If mylot > 0 And frst Then frst = False: msg = msg & " تم استخدام خامات من اللوت رقم " & Sheet2.Cells(c, 6) & " بوزن " & mylot ElseIf mylot > 0 And Not frst Then msg = msg & " وأيضا من اللوت رقم " & Sheet2.Cells(c, 6) & " بوزن " & mylot End If SumV(c) = SumV(c) + mylot: SumH(i) = SumH(i) + mylot Next c Sheet4.Range("g" & i + 9) = msg Next i MsgBox "Done by mr-mas.com" End Sub نفعنا الله جميعا بما علمنا وعلمنا ما ينفعنا

حسب فهمي للمطلوب تم وضع معادلة تحسب المتبقي على التاريخ (إذا كان بعد تاريخ اليوم) وتنسيق المدة ب data bar بالتوفيق تنسيق المتبقي على تاريخ.xlsx

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

الحمد لله رب العالمين

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

تفضل هذا التعديل Nouveau Microsoft Access Database (2).accdb سؤال جدا منطقي هذه الطريقة غير عملية جداً

شكرا لك أخي محمد صالح جزاك الله كل خير

يبدو أن حضرتك لم تقرأ هذا من قبل يجب وضع وصف دقيق ومفصل للمشكلة (تم تعديل الموضوع وإضافة الشرح الموجود بالملف) على العموم هذا ملفك بعد التعديل بملاحظة الجداول وجدت أسماءها الجدول20 والجدول21 وهكذا فتم استعمال اسم الجدول في معادلة البحث بالتوفيق بحث فى عدة جداول برقم.xlsx

Sub ADDITEM() Dim x, itemRow As Long, availRow As Long With Sheet2 If .Range("K3").Value = Empty Then Exit Sub Application.EnableEvents = False itemRow = Range("K3").Value availRow = Range("F999").End(xlUp).Row + 1 Range("B4").Value = Sheet4.Range("B" & itemRow).Value Range("D5").Value = Sheet4.Range("D" & itemRow).Value Range("B5").Value = 1 Range("F" & availRow).Value = Range("B4").Value Range("G" & availRow).Value = Range("B5").Value Range("H" & availRow).Value = Range("D5").Value Range("I" & availRow).Value = "=H" & availRow & "*G" & availRow Application.EnableEvents = True End With End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim x, xx, RecptRow As Long If Not Intersect(Target, Range("B3")) Is Nothing And Range("B3").Value <> Empty Then xx = Application.Match(Range("B3"), Sheet4.Columns(1), 0) If Not IsError(xx) Then Range("B4").Value = Sheet4.Cells(xx, 2).Value x = Application.Match(Range("B4").Value, Columns(6), 0) If IsError(x) Then ADDITEM End If If Not Intersect(Target, Range("B5,D5")) Is Nothing And Range("K2").Value = False And Range("K1").Value <> Empty Then x = Application.Match(Range("B4").Value, Columns(6), 0) If IsError(x) Then RecptRow = IIf(Range("K5").Value = 0, Range("K1").Value, Range("K5").Value) Else RecptRow = x End If If Not Intersect(Target, Range("B5")) Is Nothing Then Range("G" & RecptRow).Value = Val(Range("G" & RecptRow).Value) + Target.Value If Not Intersect(Target, Range("D5")) Is Nothing Then Range("H" & RecptRow).Value = Val(Range("H" & RecptRow).Value) + Target.Value End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("f13:i999")) Is Nothing And Range("f" & Target.Row).Value <> Empty Then Range("K1").Value = Target.Row Range("K2").Value = True Range("b4").Value = Range("F" & Target.Row).Value Range("B5").Value = Range("G" & Target.Row).Value Range("D5").Value = Range("H" & Target.Row).Value Range("K2").Value = False End If End Sub

يمكنك اخفاء ورقة العمل بدون كود كلك يمين على اسم الشيت ثم اخفاء hide ولو بالكود Sheets("sheet name").visible = False مع تغيير اسم الشيت المطلوب مكان sheet name بالتوفيق

التاريخ في حقل تاريخ الميلاد نص وليس تاريخا تم تحوله إلى تاريخ باكواد vba وإعادة تنسيقه ووضع خلية بها تاريخ حساب السن ووضع معادلة السن باليوم والشهر والسنة بالتوفيق تنسيق رياض الاطفال - Copy.xlsx

تم عمل المطلوب بمعادلة المصفوفة (Ctrl+Shift+Enter) بصفحة بحث =IFERROR(INDEX(Sheet1!$A$2:$A$2000,SMALL(IF(Sheet1!$B$2:$B$2000=$A$1,IF(Sheet1!$C$2:$C$2000="مفتوح",ROW(A$2:A$2000)-ROW(A$2)+1)),ROWS($A$3:A3))),"") اومر التوريد1.xlsx

تفضل اخي الكريم Database11.zip

حرب هذا الملف Option Explicit Sub Get_Color() Dim My_Regex As Object Dim x%, m%, La%, t% Dim arrWords, Arr() ReDim Arr(4) Arr(0) = 3: Arr(1) = 14: Arr(2) = 5: Arr(3) = 3 Set My_Regex = CreateObject("VBScript.RegExp") My_Regex.Pattern = "(\d{3})" My_Regex.Global = True With Sheets("Sheet1") La = .Cells(Rows.Count, 3).End(3).Row m = 1 With .Range("E6:E" & La) .Font.ColorIndex = 1 .ClearContents End With For t = 6 To La .Range("E" & t) = .Range("C" & t) If My_Regex.test(.Range("E" & t)) Then Set arrWords = My_Regex.Execute(.Range("E" & t)) For x = 0 To arrWords.Count - 1 Range("E" & t).Characters(m, 3) _ .Font.ColorIndex = Arr(x) m = m + 3 Next x End If m = 1 Next t End With End Sub الملف مرفق Abbadi.xlsm