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

الحل الأسهل ممكن تمد حقل العنوان على عرض التقرير وتنسق النص على (توسيط) .. بيجي معاك في النص دائما 🙂

ياهلا الاخ شايب يقول ان بعض الاستعلامات لا تقبل اضافة معيار وتظهر رسالة خطأ مثلا لو اردنا ان ان نعرض بيانات في نموذج او تقرير مصدر هذه البيانات استعلام ونرغب في عرض البيانات الخاصة بالناجحين فقط فاننا نضع المعيار في الاستعلام على سبيل المثال Forms![frm_1]![tx] اسم النموذج والحقل الذي سيتم اعتباره المعيار وفقا لما نكتبة ناجح او راسب هنا بعض الاستعلام تظهر رسالة محرك قاعدة البيانات microsoft.jet لايتعرف على Forms![frm_1]![tx] كاسم حقل اوتعبير صالح هذه الرسالة تظهر عادة في الاستعلامات الجدولية ولحل المشكلة نحتاج الى اضافة المعلامات بمعنى اننا نحتاج الى تعريف الحقل المحتوي على المعيار ونوعه اخيرا الاخ العزيز شايب يعتذر مقدما ان لم يستطع ايصال المعلومة بشكل بسيط وواضح ويترك الامر للاساتذة والخبراء الكلام

السلام عليكم 🙂 لما يكون فيه مجموعة كمبيوترات تعمل على نفس البرنامج في الشبكة ، وتكون البيانات/الجداول سواء على السيرفر او على احد الكمبيوترات في الشبكة ، ولأنه تاريخ/وقت هذه الكمبيوترات يختلف من كمبيوتر الى آخر ، فهذا يعمل لنا اختلاف في قيمة وقت ادخال السجل ، من كبيوتر الى آخر. احد المؤسسات تشتغل على برنامج يستخدمه حوالي 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 . جعفر

السلام عليكم مشاركة مع احبتي اسهل وآمن طريقة ، ومن خلالها يمكننا المحافظة على بيانات العميل فترة التجربة نتبع الخطوات التالية : 1- تقسيم قاعدة البيانات . 2- في قسم الواجهات نضع الكود المناسب في محرر الفيجوال لتحديد فترة التجربة . 3- نقوم بتحويل الواجهات الى Accde او mde 4- نرسلها للعميل عند انتهاء الفترة التجريبية سيظهر تنبيه للعميل ويقف البرنامج عن العمل ويطالبه بشراء نسخة كاملة حينها نقوم بارسال نسخة من الواجهات اليه .. ( بعد تعطيل كود الفترة ) بكذا نكون حافظنا على حقوقنا وعلى حقوق العميل وذلك بالابقاء على بياناته خلال التجربة

جرب هذا Sub ExportScreenshot() Dim pic_rng As Range Dim ShTemp As Worksheet Dim wbA As Workbook Dim ChTemp As Chart Dim PicTemp As Picture Dim name_jpg As String Dim strPath As String Dim strPathFile As String Dim myFile As Variant Set ShTemp = ActiveSheet Set wbA = ActiveWorkbook Application.ScreenUpdating = False 'تحديد النطاق المطلوب أخذ صورة له Set pic_rng = ShTemp.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 On Error GoTo errHandler 'الحصول على اسم الصورة من الخلية A1 name_jpg = Range("A1").Value & ".jpg" 'الحصول على مجلد المصنف النشط strPath = wbA.Path If strPath = "" Then strPath = Application.DefaultFilePath End If strPath = strPath & "\" strPathFile = strPath & name_jpg ' حدد مجلدًا للملف myFile = Application.GetSaveAsFilename _ (InitialFileName:=strPathFile, _ FileFilter:="jpg Files (*.jpg), *.jpg", _ Title:="حدد المجلد واسم الملف للحفظ") 'التصدير إلى صورة إذا تم تحديد مجلد If myFile <> "False" Then ChTemp.Export Filename:=myFile, FilterName:="jpg" 'رسالة تأكيد الحفظ مع معلومات الملف MsgBox "تم حفظ الصورة: " _ & vbCrLf _ & myFile End If Application.DisplayAlerts = False ShTemp.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True exitHandler: Exit Sub errHandler: MsgBox "تعذر حفظ الصورة" Resume exitHandler End Sub

شوف هذا هل يلبي طلبك؟ مدة الخدمة حسم وإضافة.xlsx

تفضل =IF(AND(A5="طائرة";OR(WEEKDAY(A1)=3;WEEKDAY(A1)=5));"مصرح بالاجازه ";"")

Private Sub Print_ws_Click() Dim answer As Integer, Path As String, folderName As String, WSPrinter As String Path = ThisWorkbook.Path & "\" 'اسم المجلد folderName = "ملف الكشف" & " " & Format(Now(), "yyyy-mm-dd") Set ws = Sheet2 On Error Resume Next MkDir Path & folderName Dim fileName As String ' اسم الملف المستخرج fileName = folderName & "\" & "DbSheet" & "_" & ".pdf" ws.ExportAsFixedFormat Type:=xlTypePDF, fileName:=Path & fileName MsgBox "" & Path & vbLf & vbLf & " " & _ folderName, _ vbInformation, " : تم حفظ الملف بنجاح في مجلد" Application.EnableCancelKey = xlDisabled WSPrinter = Application.ActivePrinter ws.Select answer = MsgBox(" طباعة الملف ؟", vbQuestion + vbYesNo + vbDefaultButton2, "تاكيد") If answer = vbYes Then ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True, ActivePrinter:="officena" Application.ActivePrinter = WSPrinter Else End If Application.EnableCancelKey = xlInterupt On Error GoTo 0 End Sub userform V3.xlsm

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

السلام عليكم 🙂 ضع هذا الملف مع ملف الاكسل "Unmanaged.xlsx" في نفس المجلد "D:\nw" ، وإلا ، فيجب تعديل المسار في الاستعلام qry_1_Excel_File (وهذا سيأخذ وقت لفتح الاستعلام 🙂) : استخدم الزر في النموذج ، حتى تعمل جدول جديد بإسم tbl_Data وبه بيانات الاكسل جاهزة لتحويلها الى اي جدول آخر ، او استعماله مباشرة في الاكسس ، ملاحظة ، يتم حذف الجدول tbl_Data ، ويتم عمله من جديد في كل مرة ، حتى نتأكد بأننا حصلنا على جميع حقول ملف الاكسل . 1569.as_Final.accdb.zip

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

الظاهر من بياناتك في الصورة في او مشاركة ، الاجازة المتصلة: تاريخ بداية الاجازة = تاريخ نهاية الاجازة السابقة + 1 يوم يمكننا عمل كود ليعمل المطلوب ، ولا ارى طريقة لعمله في استعلام !! اذن نحن بحاجة الى بيانات كثيرة ومتنوعة لتحليل وعمل اللازم 🙂

جرب الكود التالي ضعه في حدث الورقة المطلوب حماية معادلاتنها الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Set rng = Range("A2:K50") If Not Intersect(Target, rng) Is Nothing Then If Target.Value = "" Then Target.Locked = False Else Target.Locked = True End If rng.Locked = True rng.SpecialCells(xlCellTypeBlanks).Locked = False ActiveSheet.Protect Password:="password", UserInterfaceOnly:=True End If End Sub هذا الكود يعني أنه عند تغيير قيمة الخلية في النطاق المحدد (A2:K50)، يتم التحقق من حالة الخلية قبل تحديد حالة القفل عليها. إذا كانت الخلية فارغة، فسيتم إلغاء حالة القفل عنها، مما يسمح بالكتابة في الخلية. إذا تم إدخال قيمة في الخلية، فسيتم تحديد حالة القفل على الخلية، مما يعني أنه لن يتمكن أحد من تحرير أو تعديل الخلية. يتم أيضًا تحديد حالة القفل على النطاق بأكمله، ولكن يتم إلغاء حالة القفل عن جميع الخلايا الفارغة في النطاق، مما يسمح بالكتابة في هذه الخلايا الفارغة. يتم حماية الورقة بكلمة مرور "password"، ولكن باستخدام الخيار UserInterfaceOnly:=True، يتم السماح للمستخدم بتغيير القيم في الخلايا، ولكن لن يتم السماح له بإزالة الحماية أو تغيير حالة القفل على الخلايا. عند تشغيل الحماية، سيتم حماية النطاق المحدد بحيث لن يتمكن أحد من تحرير أو تعديل أي خلية في هذا النطاق، ما لم تكن الخلية فارغة حظ موفق

تفضل جرب Option Compare Text Dim f, Rng, wsData() Private Sub UserForm_Initialize() Set f = Sheets("التقرير") Set Rng = f.Range("A3:j" & f.[A65000].End(xlUp).Row) wsData = Rng.Value Me.ListBox1.List = wsData Me.ListBox1.ColumnCount = 10 Me.ListBox1.ColumnWidths = "120;65;65;80;80;65;80;65;80;65" Me.combobox1.List = Application.Transpose(Rng.Offset(-1).Resize(1)) Me.combobox1.ListIndex = 0 Me.LabelColFiltre.Caption = "بحث ب :" & Me.combobox1 End Sub Private Sub combobox1_click() Me.LabelColFiltre.Caption = "بحث ب: " & Me.combobox1 End Sub Private Sub TextBox1_Change() Réf_Colmun = Me.combobox1.ListIndex + 1 clé = "*" & Me.TextBox1 & "*": n = 0 Dim A() For i = 1 To UBound(wsData) If wsData(i, Réf_Colmun) Like clé Then n = n + 1: ReDim Preserve A(1 To UBound(wsData, 2), 1 To n) For k = 1 To UBound(wsData, 2): A(k, n) = wsData(i, k): Next k End If Next i If n > 0 Then Me.ListBox1.Column = A Else Me.ListBox1.Clear End Sub بحث في الفورم.xlsb

تفضل مخزون v6.xlsm

زيادة لما تفضل به استاذنا @Moosak استخدم هذا ... جرب ... Private Sub Report_Open(Cancel As Integer) DoCmd.Maximize Me.kan.Left = (Me.Width - Me.kan.Width) / 2 End Sub

تحت أمرك ولكن حفاظا على قوانين المنتدى افتح موضوع جديد بعنوان حساب استحقاق صرف المعاش

تفضل هذا الترقيم Dim i As Integer, x As Integer For i = 1 To 10 For x = 1 To 5 Debug.Print "(" & Format(i, "0#") & ")" & Format(x, "0##") Next x Next i النتيجة بدون الاقواس Dim i As Integer, x As Integer For i = 1 To 10 For x = 1 To 5 Debug.Print Format(i, "0#") & "-" & Format(x, "0##") Next x Next i End Sub النتيجة

طبعا لا يمكن و لكن تستطيع انشاء جدول داخل جدول من خلال اكواد HTML <table border="1" width="100%"> <tr> <td>Name 1</td> <td>Name 2</td> <td colspan="2">Name 3</td> <td>Name 4</td> </tr> <tr> <td rowspan="3">ITEM 1</td> <td rowspan="3">ITEM 2</td> <td>name</td> <td>price</td> <td rowspan="3">ITEM 4</td> </tr> <tr> <td>name</td> <td>price</td> </tr> <tr> <td>name</td> <td>price</td> </tr> </table> و النتيجة تكون التالي ارفق مثالك و سيتم التطبيق عليه انشاء الله

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

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

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

وعليكم السلام ورحمة الله وبركاته قواعد المشاركة بمنتدي أوفيسنا بالنسبه لطلبك الأول هو موجود فعليا في البند رقم ٢٣ 23. ممنوع نهائيا وبشكل قاطع تكرار الموضوع نفسه أو فتح موضوع جديد للمطالبة برد في موضوع سابق، كما يمنع منعا باتا ذكر أكثر من سؤال في نفس الموضوع، وهذا لكي يسهل البحث والحصول على المعلومة على من بعدك بالنسبه لطلبك الثانى هو موجود فعليا في البند رقم ١٩ 19. تجنب نشر بيانات حقيقية يخشى نشرها ويمكن أن تطلب حذفها لاحقاً

وعليكم السلام 🙂 الطريقة الصحيحة هي ، بإعطاء الطالب رقم لا يتغير (حقل رقم الطالب) ، وحقل آخر للصف ، وكلما انتقل الطالب الى الصف التالي ، يمكنك اضافة رقم 1 الى الصف الحالي 🙂 خذها قاعدة: في قواعد البيانات ، وبما ان السرعة مطلوبة ، فإجعل لكل معلومة حقل خاص بها ، وهذا سيسهل عليك ربط الجداول بطريقة مباشرة كذلك.

هل تريد الحساب على أساس الشهر 30 يوما أم الحساب على الأيام الفعلية للشهر فبعضها 31 يوم وأخرى 30 و 29 و 28

جمع عدد ايام و عدد اشهر و سنوات مع التقريب.rar

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

وعليكم السلام هذا كود أنا مستخدمه في أداة التقويم الدراسي يحفظ الصورة في سطح المكتب عدل فيه حسب احتياجك 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

نعم.. الاسماء ربما تصادف مشكلة... اذن المرحلة الاولى اقوم باضافة القسم والرقم الوظيفي والاسم في مصنف data1 وبعد ذلك اعيد ادخال القسم والرقم الوظيفي والاسم والشهر والراتب والخصم في data... جزا الله خير وجعله في ميزان حسناتك

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

مشكلة في زيادة نطاق مسح محتويات الخلايا تصفير.xlsb

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

فيه خلايا المفروض متتمسحش

إذا بتمسح نطاق Sub تصفير_2_معادلات() Range("c8:ck400").ClearContents End Sub

تفضل اخي تم اصلاح بعض الاخطاء في الاكواد سبب تهنيج الملف هو كود اظهار الساعة على اليوزرفورم قد تم استبداله بطريقة اخرى 1) تم تفعيل اكواد يوزرفورم 3 كما طلبت من قبل بطريقتين مختلفتين يمكنك اختيار ما يناسبك. 2) تم تعديل اكواد يوزرفورم 1 لتتماشى مع طريقة اشتغال الملف 3) تم استبدال معادلة ادراج تاريخ اليوم في عمود A بالكود التالي تفاديا لاظهار رسالة (Circular reference) Private Sub Worksheet_Change(ByVal TaFet As Range) Dim myRng As Range, F As Range, Col As Integer, lr As Long Set myRng = Intersect(Application.ActiveSheet.Range("B3:B2000"), TaFet) 'Column("A") Col = -1 If Not myRng Is Nothing Then For Each F In myRng If Not VBA.IsEmpty(F.Value) Then F.Offset(0, Col).Value = Now F.Offset(0, Col).NumberFormat = "dd-mm-yyyy" Else F.Offset(0, Col).ClearContents End If Next End If End Sub اكواد يوزرفورم 3 Dim F, K, WS_Data(), LigneN_Row Private Sub UserForm_Initialize() Set F = Sheet5 'Worksheets("الدخول") Set K = F.Range("A3:V" & F.[A65000].End(xlUp).Row) WS_Data = K.Value Set Réf = CreateObject("Scripting.Dictionary") a = F.Range("j3:j" & F.[j65000].End(xlUp).Row) For I = LBound(a) To UBound(a) If a(I, 1) <> Empty Then Réf(a(I, 1)) = Empty Next I WS2 = Réf.keys Me.ComboBox1.List = WS2 vidange_Click Me.TextBox1.SetFocus ComboBox1 = "*" Me.N_Row.Visible = False End Sub '''''''''''''''''''''''''''''' Private Sub ListBox1_Click() Me.TextBox1.Value = Me.ListBox1.Column(0) Me.ListBox1.Visible = False For I = 1 To UBound(WS_Data) If WS_Data(I, 10) = Me.TextBox1.Text Then N_linge = I Me.N_Row = N_linge + K.Row - 1 End If Next I Me.TextBox2.Text = WS_Data(N_linge, 10) ''''''''''''''' ' جلب التاريخ والساعة 'Me.TextBox3.Text = WS_Data(N_linge, 1) 'جلب التاريخ فقط Me.TextBox3.Text = Format(CDate(WS_Data(N_linge, 1)), "MM/DD/YYYY") '''''''''''''' Me.TextBox4.Text = WS_Data(N_linge, 6) Me.TextBox5.Text = WS_Data(N_linge, 7) Me.TextBox6.Text = WS_Data(N_linge, 9) Me.TextBox7.Text = WS_Data(N_linge, 2) Me.ComboBox1 = "*" Me.TextBox1 = "" End Sub '''''''''''''''''''''''''''' Private Sub TextBox1_Change() If Me.TextBox1.Text = "" Then Me.ListBox1.Visible = False Else Me.ListBox1.Visible = True Me.ListBox1.Clear '------------------------------ Dim K Set w = Sheet5 K = w.Cells(Rows.Count, 10).End(xlUp).Row l = 0 For Each c In Range("j3:j" & K) If c Like TextBox1.Text & "*" Then ListBox1.AddItem ListBox1.List(l, 0) = Cells(c.Row, 10).Value l = l + 1 End If Next c End If Me.ComboBox1 = "*" End Sub Private Sub vidange_Click() For I = 1 To 7 Controls("textbox" & I).Text = Empty Next I Me.ComboBox1 = "*" End Sub Private Sub TextBox1_DblClick(ByVal cancel As MSForms.ReturnBoolean) If Not iGblInhibitTextBoxEvents Then TextBox1.Value = "" Me.ComboBox1 = "*" End If End Sub ''''''''''''''''''''''''''' Private Sub ComboBox1_click() For I = 1 To UBound(WS_Data) If WS_Data(I, 10) = Me.ComboBox1.Text Then N_linge = I Me.N_Row = N_linge + K.Row - 1 End If Next I Me.TextBox2.Text = WS_Data(N_linge, 10) ''''''''''''''' ' جلب التاريخ والساعة 'Me.TextBox3.Text = WS_Data(N_linge, 1) 'جلب التاريخ فقط Me.TextBox3.Text = Format(CDate(WS_Data(N_linge, 1)), "MM/DD/YYYY") '''''''''''''' Me.TextBox4.Text = WS_Data(N_linge, 6) Me.TextBox5.Text = WS_Data(N_linge, 7) Me.TextBox6.Text = WS_Data(N_linge, 9) Me.TextBox7.Text = WS_Data(N_linge, 2) Me.TextBox1.Text = Empty End Sub في انتظار ان توافينا بالنتيجة بعد التجربة بالتوفيق مخزون V3.xlsm

المفروض العدد 91 بس ظاهر 230 لانه عد الصفر لان الاسماء دي نسخ من ورقة 1 والدالة المدى بتاعها من A1 الى A230 New ورقة عمل Microsoft Excel.xlsx

السلام عليكم و رحمة الله اجعل الدالة هكذا =COUNTIF(A1:A230;"<>"&"0")

السلام عليكم : الاعضاء الافاضل كل عام وانتم بخير .. بحلول شهر ذي الحجة اليكم . اداة ادراج التاريخ ... واستخدامها في الاكسل من خلال تواجدها في شريط الادوات للصفحة الرئيسية لكيفية استخدامها تابع الصور ... Datepicker.zip

استاذي @Mohamed Hicham لم اجرب الكود لاني شغال من الهاتف المحمول اعذرني لو فيه خطأ

السّلام عليكم و رحمة الله و بركاته قمّة الفرح و منتهى السّعادة و أنا أطرق باب بيتي التعليمي " أوفيسنا " .. حامِلاً معي حقيبة أكوادي .. ومن ضمنها " الوابْ بْروصرْ " من محرّر الأكواد ومن خلال " صندوق الأدوات " إضغط على السّهم ..كليك يمين ..أدوات إضافية ثم من خلال القائمة المنسدلة .. قم يالتأشير على خانة " الوابْ بْروصرْ "..مثلما بالصّور المرقمّة بالتّرتيب : وها قد أصبح لديك الآن على اليوزرفورم كائن يسمّى " الوابْ بْروصرْ " قمْ بإضافة هذا المولود الجديد على اليوزرفورم كإضافة أي كائن آخر مثله مثل الليبل أو التاكست-ليست-كومبو بوكس من حيث الحجم كالتّكبير أو التّصغير .. و إذا كنت مرهقًا ..لا عليك .. فقط بالضغط على هذا " الوابْ بْروصرْ " في هذا الملف المرفق رقم 1 .. ثم نسخ و لصق بملفك الشخصي .. مع نقل الأكواد طبعًا .. و التّغيير في العبارة أو العبارات التي تودّ إظهارها على الشّريط المتحرّك قد يتساءل أحد منّا ولو بنفسه .. وهل نحن بحاجة بأن تعرّفنا على هذا " الوابْ بْروصرْ " يا عبد العزيز البسكري ..!!؟؟ و سأجيب بكل بساطة .. لا .. طبعًا .. أنا لا أتكلم بهذا الموضوع عن الطّائرة ..و إنّما قصدتُ جناحَ الطائرة المفقود .. وهو ظهور الشّريط المتحرّك من اليمين لليسار بشكل يواكب لغتنا الأم .. اللّغة العربية .. و نمنحُها أسمى معانيها وضعتُ ملفيْن مرفقيْن ..للمقارنة بينهما و ستلاحظون أنّ التّغيير وقع فقط بجزئية تغيير الاتّجاه .. أساتذتي الأفاضل قد يكون الموضوع بسيطًا لكن عسى أن ينتفع به المبتدئون أمثالي و السّلام عليكم و رحمة الله و بركاته خالص إحتراماتي الواب بروصر يمين يسار.rar