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

السلام عليكم ورحمة الله وبركاته أعضاء المنتدى الكرام تحية طيبة نسأل الله أن يمتعنا وإياكم بالعافية هذا برنامج إهداء لكم أعزائي الكرام وقد قمت بتصميمه ولله الحمد بتوفيق من الله هذا البرنامج يفيد المعلم في الحصة طبعا البرنامج يحتوي على 3 فصول دراسية وقابل لزيادة الفصول الدراسية لكن سيحتاج إلى تعديل خاصة في فورم (صفحة التقرير الشهري) وأسأل الله أن ينفع بها المسلمين حضور وغياب - يوزر فورم.xlsm

السلام عليكم أخي الكريم ...... ولكم بمثل ما دعوتم آمين بناء على طلبك - أخي الكريم - تم التعديل، مع ملاحظة أن الورقتين Data & Result تعتمدان في معرفة القسم والرقم الوظيفي على الورقة الأولى Data1 وكذلك يمكنك التحديث لكتابة الأسماء آلياً بتحديث Pivot table بجانب الجدول في ورقة Result أما إن أردت كتابة الاسم يدوياً ستقوم بإلغاء المعادلة التي تربط خلايا الاسم بالجدول المجاور لكن لا يضمن أن تكتب الاسم بحذافيره دون زيادة أو نقصان فتكون النتائج تابعة لدقة كتابتك للاسم تقبل تحياتي والسلام عليكم. Abu Rafat (1).xlsx

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

السلام عليكم 🙂 لما يكون فيه مجموعة كمبيوترات تعمل على نفس البرنامج في الشبكة ، وتكون البيانات/الجداول سواء على السيرفر او على احد الكمبيوترات في الشبكة ، ولأنه تاريخ/وقت هذه الكمبيوترات يختلف من كمبيوتر الى آخر ، فهذا يعمل لنا اختلاف في قيمة وقت ادخال السجل ، من كبيوتر الى آخر. احد المؤسسات تشتغل على برنامج يستخدمه حوالي 6 اشخاص ، ويتم ادخال حوالي 2000 سجل يوميا ، والجدول فيه حقل رقم تلقائي ، وحقل التاريخ/الوقت وفيه قيمة افتراضية Now ، طبعا بالاضافة الى بقية الحقول. حقل الرقم التلقائي ما فيه اشكالية في تسلسل الارقام ، ولكن حقل التاريخ/الوقت لا يأخذ قيمة Now من السيرفر ، وانما يأخذه من الكمبيوتر الذي يعمل السجل ، واذا تاريخ/وقت اي من الكمبيوترات خطأ ، مما يعني انه من الصعب/المستحيل معرفة متى تم ادخال هذا السجل بوقته الصحيح مقارنة مع باقي السجلات. قد لا يشكل هذا مشكلة عند البعض ، ولكنه يشكل مشكلة ومعضله عندما تكون البيانات حساسة ومهمة ، ومعرفة من ادخل المعلومة و متى. توصلت الى الاستعانة بالدوال التالية ، واستعملها اول ما افتح البرنامج (ولمرة واحدة فقط) ، و اضع في المتغير Diff_Sec فرق التاريخ/الوقت بالثواني ، بين السيرفر والكمبيوتر ، ولما اضيف السجل اضيف قيمة هذا المتغير الى Now الكمبيوتر ، مما يعطي السجل وقت السيرفر ، وعليه تكون جميع السجلات تعمل على نفس التوقيت 🙂 اقوم بمناداة الدالة هكذا: call Get_Remote_PC_Time("\\192.168.100.88") Option Compare Database Option Explicit 'Fetch and display Net Remote Time Of Day from a 'remote Windows system. Supply a UNC hostname '(or a DNS name), or empty string for the local 'host's time and date. ' Private Const NERR_SUCCESS As Long = 0 Private Type TIME_OF_DAY_INFO tod_elapsedt As Long tod_msecs As Long tod_hours As Long tod_mins As Long tod_secs As Long tod_hunds As Long tod_timezone As Long tod_tinterval As Long tod_day As Long tod_month As Long tod_year As Long tod_weekday As Long End Type #If Win64 Or VBA7 Then Dim lngBufPtr As LongPtr Private Declare PtrSafe Function NetApiBufferFree Lib "netapi32" _ (ByVal lpBuffer As LongPtr) As Long Private Declare PtrSafe Function NetRemoteTOD Lib "netapi32" _ (UncServerName As Byte, BufferPtr As LongPtr) As Long Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (pTo As Any, uFrom As Any, ByVal lSize As LongPtr) #Else Dim lngBufPtr As Long Private Declare Function NetApiBufferFree Lib "netapi32" _ (ByVal lpBuffer As Long) As Long Private Declare Function NetRemoteTOD Lib "netapi32" _ (UncServerName As Byte, BufferPtr As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (pTo As Any, uFrom As Any, ByVal lSize As Long) #End If ' Public Diff_Sec As Double ' Public Function GetTOD(ByVal Server As String) As Date Dim bytServer() As Byte 'Dim lngBufPtr As Long Dim todReturned As TIME_OF_DAY_INFO bytServer = Trim$(Server) & vbNullChar If NetRemoteTOD(bytServer(0), lngBufPtr) = NERR_SUCCESS Then CopyMemory todReturned, ByVal lngBufPtr, LenB(todReturned) NetApiBufferFree lngBufPtr With todReturned GetTOD = DateAdd("n", _ -.tod_timezone, _ DateSerial(.tod_year, .tod_month, .tod_day) _ + TimeSerial(.tod_hours, .tod_mins, .tod_secs)) End With Else Err.Raise vbObjectError + 2000, _ "GetTOD", _ "Failed to obtain server time" End If End Function Public Function Get_Remote_PC_Time(txtServer As String) ' ' calling it: 'Get_Remote_PC_Time("\\192.168.100.88") ' Dim dtServerTime As Date 'Dim Diff_Sec As Double On Error Resume Next dtServerTime = GetTOD(txtServer) Diff_Sec = DateDiff("s", Now, dtServerTime) Debug.Print "Diff=" & Diff_Sec Debug.Print "Server=" & dtServerTime Debug.Print "Local ok= " & DateAdd("s", Diff_Sec, Now) ' If Err.Number <> 0 Then ' Debug.Print Err.Description ' Else ' Debug.Print CStr(dtServerTime) ' End If ' On Error GoTo 0 '' txtServer.SetFocus End Function . جعفر

وعليكم السلام هذا كود أنا مستخدمه في أداة التقويم الدراسي يحفظ الصورة في سطح المكتب عدل فيه حسب احتياجك Sub ExportScreenshot() Dim Path As String Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "Capture.jpg" Dim pic_rng As Range Dim ShTemp As Worksheet Dim ChTemp As Chart Dim PicTemp As Picture Application.ScreenUpdating = False Set pic_rng = Worksheets("ورقة1").Range("D2:AR34") Set ShTemp = Worksheets.Add Charts.Add ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name Set ChTemp = ActiveChart pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture ChTemp.Paste Set PicTemp = Selection With ChTemp.Parent .Width = PicTemp.Width + 800 .Height = PicTemp.Height + 350 End With ChTemp.Export Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "تقويم اكسل.jpg", Filtername:="jpg" MsgBox "تم حفظ صورة للتقوم على سطح المكتب" & vbNewLine & "تقويم اكسل.jpg" & vbNewLine & " يمكن الاستفادة منها لتكون خلفية لسطح المكتب" & vbNewLine & "لايقاف الرسال أو منع حفظ الصورة حدد الخيار من تبويب صفحة حول", , "التقويم" Application.DisplayAlerts = False ShTemp.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

وعليكم السلام ورحمة الله وبركاته 🙂 لا أعلم طريقة لتكبير الخط .. ولكن كمقترح يمكنك بناء نموذج خاص بك لعرض الرسائل وتتحكم فيه بالحجم والشكل والألوان كما تحب 🙂

حدد الأعمدة التي تريد مسحها واحفظه باسم (Name_Rang) مثلا ثم استخدم الأمر التالي Sub Clear_Name_Rang() Application.ScreenUpdating = False Range("Name_Rang").ClearContents Application.ScreenUpdating = True End Sub ملاحظة المرفق تحديد عشوائي للتوضيح

السلام عليكم ورحمة الله وبركاته تحية طيبة أعزائي الكرام هذا برنامج قمت بتصميمه ولله الحمد وفيه نواقص تحتاج لإكمال، وسأذكرها لكم إن شاء الله. سبب عدم إكمالي للبرنامج عدم حاجتي فيه؛ فقد استغنيت عنه ببرنامج Notion المشهور لكن على العموم قد يستفيد أحد منه وهو إضافة لعالم الإكسيل برنامج خاص للمصاريف الشخصية متطور وبشكل جميل عبر اليوزر فورم المهم النواقص التي تحتاج لإكمال لمن يحب أن يطورها وينتفع بها أو ينفع بها غيره من المسلمين: 1- دبل كليك على اللست بوكس ليظهر البيانات على التكست بوكس 2- في page2 عمل إحصائية شهرية وسنوية وممكن نستفيد من شيت الإحصائية لأخذ الأفكار وتطبيقها في الفورم 3- عندي مشكلة في التاريخ مازلت تتكرر لا أدري الخلل من جهازي أو من الكود بحث يعطيني MM/DD الشهر قبل اليوم وحاولت أعالجه ما ضبط معي 4- ممكن تعديل كود الباقي على الراتب القادم بحيث لو باقي 0 يوم ينزل إلى الخلية التي تحته ليقرأ الباقي على الراتب للشهر القادم 5- هذا ما جاء في بالي على عجالة وممكن مع تطوير البرنامج تأتي أفكار أخرى ونسأل الله أن ينفع بها المسلمين وأن يعيننا على نشر العلم وإخراج زكاته لوجه الله تبارك وتعالى وأن يجعل أعمالنا خالصة له ونبتغي بهذه البرامج نفع الناس والأجر من الله. برنامج مصاريف - يوزر فورم.xlsm

السلام عليكم أتمنى من القائمين على هذا المنتدى المبارك إضافة بنود جديد على قواعد المشاركة في الموقع ومنها : 1- عدم طرح سؤال جديد أو طلب جديد من خلال الردود 2- عدم رفع ملفات تحتوي على معلومات لأشخاص حقيقيين خاصة البند الأول أحدهم يسأل في بداية الموضوع عن معادلة جمع A1 مع B1 وفي نهاية الموضع تكون سويت له برنامج محاسبي. أعان الله الجميع ووفقهم أرجو عدم الزعل فنحن إخوان والصراحة بيننا مطلوبة والعتب على قدر المحبة

المنتدى به الكثير من المواضيع لجلب الوقت من الانترنت ، ولكن لم ارى موضوع لتوحيد تاريخ/وقت كمبيوترات الشبكة ، وهذا هو صلب الموضوع 🙂 قمت بإضافة شرح لسبب استخدامي لهذا الموضوع 🙂 جعفر

بحث بالاسم في تيكست بوكس.xlsm

ما شاء الله الله أكبـــــر سلمت يمناكم استاذى الجليل ومعلمى القدير و والدى الحبيب

عدل الرقم 2 إلى الرقم الذي تريد

هذا أصل الموضوع .. هل تمت الإجابة عليه؟ إذا نعم افتح موضوع جديد لإجابة عليه وإذا لا نتناقش في الحلول المتاحة

استخدم هذه المعادلة في خلية K12 أو أي خلية أخرى =MAXIFS(Table1[RATE];Table1[Order Date :];"<"&$H$4;Table1[Item Code];E12)

أستاذي اللي أنا شايف هذي نفس البيانات بشيت 1 إلا إذا أنت تتكلم عن ملف آخر أما صنفين A و B أنا ما عندي ملف فيه صنفين A و B شوف الصورة الشيت2 بتسمع صح من الشيت1 إذا فيه ملاحظات خليها بالصور عشان أفهم ولأساتذة يفهمون يمكن عندهم حلول أفضل

وعليكم السلام =IF(OR(WEEKDAY(A1)=3;WEEKDAY(A1)=5);"مصرح بالاجازه ";"")

أخي الكريم عندما تدخل الاسم في Data ستتم كتابة الرقم الوظيفي والقسم آلياُ ... وجزاكم بمثل ما دعوتم أخي الكريم

شكرا لك اخوي خالد على التجربة واخبارنا بذلك 🙂

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

وعليكم السلام ورحمة الله وبركاته ممكن تجرب هذه الملفات ربما تضبط معك Excel e whatapp.xlsm Send Via Whatsapp.xlsm برنامج الوتساب.xlsm

السلام عليكم اخوي خالد 🙂 هل اصبح التقرير اسرع من برنامجك السابق ، وخصوصا لما تنتقل بين الصفحات 😁 وهل اكملت تضبيط بقية حقول التقرير ؟

ربما Sub test() Dim r& With ActiveSheet r = .Cells(Rows.Count, 4).End(xlUp).Row .Range("D4:I" & r).SpecialCells(4).Delete Shift:=xlUp .Range("$D$3:$D$" & r).RemoveDuplicates 1, 1 End With End Sub

المشكلة أخي ليس من اليوزرفورم المشكلة من مكان جلب البيانات حاول مراجعة المعادلة الموجودة في ورقة الادخال عمود CF . وإعادة ظبط نطاق القوائم المنسدلة. المهم تم استبدال عمود جلب البيانات الى عمود CK اي اظافة جديدة أو تعديل قم باظافتها هناك لتظهر معك على الكومبوبوكس مخزون V5.xlsm

السلام عليكم اخي بلال هل كان هذا طلبك؟

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

تفضل اخي userform.New.xlsm

شكرا اخوي عمر 🙂 بس علشان الجميع يكون معانا على نفس الموجه ، هذه جميع بيانات الجداول والنماذج من جدول MSysObjects واللي فيها البيانات المطلوبة ، واللي على اساسها قام اخوي عمر بتصفية السجلات

السلام عليكم أخي الكريم أبو رأفت عساكم من عواده، أسأل الله تعالى أن يتقبل منا ومنكم صالح الأعمال،كل عام وأنتم إلى الله تعالى أقرب ...آمين أما بعد: لم توضح أخي الكريم شكل النتائج المتوقعة وفي أي ورقة تريد التعديل، وبما أنك لم تحدد ذلك فإنني قمت بإضافة شيت - سمه ما شئت - تضع فيه القسم ورقم الموظف واسمه لمرة واحدة وفي شيت النتائج قمت بالتعديل وليس كل ما طلبت، حيث أنك طلبت خصم الأشهر الثلاثة يمكن إضافة ذلك حسب أرباع السنة وفيما يلي أعرض لك نتيجة ما قمت به ضمن الملف المرفق: تقبل تحياتي Abu Rafat.xlsx

السلام عليكم في دوال التغيير ، لا تعمل لها تنسيق عن طريق الامر Format ، فعندها يتحول متغير التاريخ الى نص ، والسبب هو انك قد تحتاج الى استعمال هذه الدالة مرة اخرى بتنسيق آخر. لذا قم بعمل التنسيق بعد جلب البيانات من الدالة. وامر CDate ليس مضمونا ان يحول النص الى تاريخ ، والامر الاصح هو DateSerial ، حتى لا يختلط الشهر باليوم . هكذا اصبحت دالة ToHijri : Option Compare Database Option Explicit Private CorctAdjustDay As Integer Private SavedCal As Integer Private d As Date Private s As String 'التحويل من التاريخ الميلادى للهجرى Public Function ToHijri(ByRef myData As String) 'إحضار القيمة العددية لفرق الأيام من جدول إعداد ضبط التاريخ الهجرى CorctAdjustDay = DLookup("[AdjustDay]", "tblAdjustHjriDate") 'ضبط التاريخ الميلادى بالزيادة أوالنقصان 'حسب القيمة العددية والتى تساوى التاريخ الهجرى 'myData = Trim(Format(DateAdd("d", CorctAdjustDay, myData), "dd/mm/yyyy")) myData = Trim(DateAdd("d", CorctAdjustDay, myData)) 'التحويل من التاريخ الميلادى للهجرى SavedCal = Calendar VBA.Calendar = 0 'd = CDate(myData) d = myData 'Hijri VBA.Calendar = 1 s = CStr(d) 'ToHijri = Format(s, "dd/mm/yyyy") ToHijri = s VBA.Calendar = SavedCal 'يتم استدعاء الموديول بالشكل التالى 'txt Hijri date = ToHijri(txt Milady date) End Function . وهكذا نناديها (لاحظ التنسيق يتم بعد مناداة الدالة) ، وهنا استخدم جدول tbl_Months لنحصل على الاسماء باللغة العربية : Private Sub Report_Load() On Error Resume Next DoCmd.ShowToolbar "Ribbon", acToolbarNo Dim Arabic_Month As String 'Georgian Arabic_Month = DLookup("[Months_Georgian]", "tbl_Months", "[Months_English]='" & Format(Date, "mmmm") & "'") Me.H_TEXT = ConArNum(Format(Date, "dd ")) & _ Arabic_Month & _ ConArNum(Format(Date, " yyyy م")) 'Hijri Me.txtHijriDate = ToHijri(Date) Arabic_Month = DLookup("[Months_Hijri]", "tbl_Months", "[Months_Number]=" & Month(Me.txtHijriDate)) Me.txtHijriDate = ConArNum(Format(Me.txtHijriDate, "dd ")) & _ Arabic_Month & _ ConArNum(Format(Me.txtHijriDate, " yyyy هـ")) End Sub . الدالة ConArNum هي لتحويل الارقام العربية الى ارقام هندية (نعم الارقام التي نستخدمها هي ارقام هندية) : Public Function ConArNum(ByVal strStringToConvert As String) As String ' 'https://www.vbforums.com/showthread.php?584388-Arabic-Numbers-display-on-one-machine-but-not-another&p=3609151&viewfull=1#post3609151 ' ' Convert the Arabic number to Indian ' On Error GoTo ErrorHandler strStringToConvert = Replace$(strStringToConvert, "0", ChrW$(1632)) strStringToConvert = Replace$(strStringToConvert, "1", ChrW$(1633)) strStringToConvert = Replace$(strStringToConvert, "2", ChrW$(1634)) strStringToConvert = Replace$(strStringToConvert, "3", ChrW$(1635)) strStringToConvert = Replace$(strStringToConvert, "4", ChrW$(1636)) strStringToConvert = Replace$(strStringToConvert, "5", ChrW$(1637)) strStringToConvert = Replace$(strStringToConvert, "6", ChrW$(1638)) strStringToConvert = Replace$(strStringToConvert, "7", ChrW$(1639)) strStringToConvert = Replace$(strStringToConvert, "8", ChrW$(1640)) strStringToConvert = Replace$(strStringToConvert, "9", ChrW$(1641)) ConArNum = strStringToConvert Exit Function ErrorHandler: ConArNum = vbNullString End Function . اما جدول tbl_Months ، وتستطيع قراءة طريقة استعماله وفوائده من هنا: https://www.officena.net/ib/topic/81063-كتابة-التاريخ-بصيغة-لا-تتغير-بتغير-اعدادات-الوندوز/ . والنتيجة النهائية هي : 1574.الارقام.accdb.zip

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

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