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

وعليكم السلام 🙂 اعمل نسخة احتياطية قبل العمل !! انزل هذا البرنامج المجاني : http://www.skrol29.com/us/vtools.php وبعد التنصيب ، استعمل خاصية . . جعفر

Requery يقوم بتحديث البيانات من مصدر السجل ويعكس كافة التغييرات التي تمت على السجلات ويعيدك للسجل الاول refersh يحدث البيانات الحالية في النموذج وماتم عليها من تعديل

وعليكم السلام 🙂 تفضل ، الكود : Private Sub code_BeforeUpdate(Cancel As Integer) If Len(Me.code & "") <> 0 And Left(Me.code, 1) = 3 Then MsgBox "الرقم يبدأ بالرقم 3" End If End Sub . والاسم : Private Sub name_BeforeUpdate(Cancel As Integer) If Len(Me![name] & "") <> 0 And Left(Me![name], 1) = "S" Then MsgBox "الاسم يبدأ بالحرف S" End If End Sub جعفر 1220.CodeName.mdb.zip

1-على حدود الجدول يجب ان تكون خلايا فارغة ( خلايا الاجمالي و ما الى ذلك يجب ان تبتعد عن الجدول ولو بصف واحد فارغ) الكود Option Explicit Sub copy_Range() Dim Soucre As Worksheet, Targ As Worksheet Dim Rg_s As Range, Dist As Range, Ro%, Last_ro% Set Soucre = Sheets("القيود") Set Targ = Sheets("ورقة1") Last_ro% = Targ.Cells(Rows.Count, 1).End(3).Row + 1 Set Rg_s = Soucre.Range("A5").CurrentRegion Ro = Rg_s.Rows.Count If Ro = 1 Then Exit Sub Set Rg_s = Rg_s.Offset(1).Resize(Ro - 1) Targ.Cells(Last_ro, 1).Resize(Rg_s.Rows.Count, Rg_s.Columns.Count).Value = _ Rg_s.Value Rg_s.ClearContents End Sub الملف مرفق 11_salim.xlsm

الرسالة تقول ، لتنصيب البرنامج ، افتح الاكسس هكذا : 1. بالفأرة اليمين ، انقر على ايقونة الاكسس ، 2. 3. افتح الاكسس جعفر

وعليكم السلام بالطبع لا يمكن عمل هذا الا بدالة معرفة Option Explicit Function Lookup_concat(Search_string As String, _ Search_in_col As Range, Return_val_col As Range) Dim i As Long Dim result As String For i = 1 To Search_in_col.Count If Search_in_col.Cells(i, 1) = Search_string Then result = result & "," & Return_val_col.Cells(i, 1).Value End If Next Lookup_concat = Trim(result) End Function ووضع هذه المعادلة بداية من الخلية H3 سحباً للأسفل =Lookup_concat($G3,$A$2:$A$700,$B$2:$B$700) Test1.xlsm

تفضل لك ما طلبت بعد اذن الأستاذ الرائد اخر عملية وعدد الشهور1.xlsx

تفضل هذه الفيديوهات ستساعدك فى القضاء عليه https://www.youtube.com/watch?v=TJadvSU4KKc https://www.youtube.com/watch?v=Cxcg3hXlE1A

جرب هذا الكود Option Explicit Sub GET_DATE_OFF() Dim Sh As Worksheet Dim Ro%, i%, My_rg As Range, Cel As Range Dim Dic As Object, arr Set Sh = Sheets("New Fomat Attendance") Set Dic = CreateObject("Scripting.Dictionary") Ro = Sh.Cells(Rows.Count, 1).End(3).Row If Ro < 5 Then Exit Sub Sh.Range("AI5").Resize(Ro).ClearContents For i = 5 To Ro Set My_rg = Sh.Range("D" & i).Resize(, 31) For Each Cel In My_rg If UCase(Cel) = UCase("OFF") Then Dic(Cells(4, Cel.Column).Value) = _ Dic(Cells(4, Cel.Column).Value) & "," End If Next Cel If Dic.Count Then Sh.Range("AI" & i) = Join(Dic.Keys, " , ") End If Dic.RemoveAll Next i End Sub الملف مرفق Abscent_Date.xlsm

تفضل اخر عملية وعدد الشهور.xlsx

هدية متواضعه الاصدار الاخير من برنامج تسجيل الديون ومتابعتها اهداء لكم مفتوح المصدر اوفيس 2013 تسجيل الديون ودفعها 2020.accdb

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

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

جرب الان الاقساط.accdb

وعليكم السلام 🙂 تفضل جرب المرفق . جعفر 1219.منظومة استرجاعات فواتير العلاج.accdb

اظهار 5 صفوف الاخيرة فقط على الليست بوكس تفضل تعديل البيانات.xlsm

قم بعمل مسح لمديات معينة الغي هذا السطر Range("a6:g150").ClearContents واستبدله بهذا Range("a6:c150").ClearContents Range("f6:g150").ClearContents

جرب هذا الملف (ربما كان المطلوب) Mabieat.xlsx

هلا اخي ممكن عمل التالي: 1 - اكتب وصف للاستعلام في خواص الاستعلام كما في الصورة 2- انقر بالزر الايمن و اختار تفاصيل 3- هنا سترى تفاصيل لكل استعلام بالتوفيق

بالتأكيد يمكن عمل هذا ببساطة -تفضل تم التعديل على الملف , وبكده يجب غلق الموضوع فتم تنفيذ كل طلباتك وذلك حتى لا يأخذ الموضوع أكبر من حجمه Abscent_Date1.xlsm

جرب هذا الملف ( الصفحة Salim ) الكود Option Explicit Sub Salim_macro() Application.ScreenUpdating = False Dim lrB% lrB = Cells(Rows.Count, 2).End(3).Row Range("H5:K500").Clear Range("B5:E" & lrB).Copy With Range("H5") .PasteSpecial (12) .PasteSpecial (8) .PasteSpecial (xlPasteFormats) With .Offset(, 2).Resize(lrB - 4) .SpecialCells(4).Formula = "=J5" .Interior.ColorIndex = 6 End With .CurrentRegion.Borders.LineStyle = 1 .CurrentRegion.InsertIndent 1 End With Application.CutCopyMode = False Range("J5").Select Application.ScreenUpdating = True End Sub الملف مرفق Copy_my_data.xlsm

هلا يمكنك تسجيل المستخدم الحالي في متغير تبع TempVars مثال 'خزن المستخدم الحالي TempVars("CurrentUser") = cboLoginUser.value 'اعرض المستخدم الحالي lblCurrentUSer.Caption = TempVars("CurrentUser") بالتوفيق

1. قد لا يكفيك الاستعلام qry_Calc_Data ، وانما قد تحتاج الى الاستعلام qry_Calc_Data2 او حتى 3 ، حتى لا يعطيك الاكسس خطأ "الاستعلام معقد جدا" ، فقد يجب عليك توزيع الحقول على استعلامين او 3 ، وفي كل استعلام يجب ان يكون عندك الحقل Data_ID ، والذي سنستخدمه لربط الاستعلامات مع بعض ، ومع الجدوا Data . 2. طبعا لا ، لأنه هو الاساس في العمل ، وطريقة العرض ستكون عن طريق الاستعلام ، وذلك بدمج مجموعة استعلامات qry_Calc_Data والجدول Data ، وهذا الاستعلام سيكون مصدر بيانات النموذج او التقرير. 3. علشان تربط بيانات الجدول Data مع بيانات الاستعلام/الاستعلامات ، يجب ان يكون عندك حقل مشترك بينهم ، وبما ان هذا الحقل يأخذ بياناته من الحقل ID في الجدول Data1 ، فعملنا العلاقة بين الجدولين 🙂 جعفر

جرب هذا الكود Option Explicit Sub Get_Month() Dim rg As Range Dim x%, i% Set rg = Sheets("Monthly").Range("A7:A18") If Application.CountA(rg) = 12 Then rg.Value = "" End If For i = 0 To ListBox1.ListCount - 1 x = Application.CountA(rg) + 1 If x = 13 Then rg.Value = "" If ListBox1.Selected(i) Then rg.Cells(x) = ListBox1.List(i) x = x + 1 If x = 13 Then Exit Sub End If Next End End Sub '++++++++++++++++++++++++++++++++++++++++++ Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ' 13 Enter key Get_Month End If End Sub الملف مرفق MY_Months.xlsm

الحمد لله ان تم الامر

وعليكم السلام-لك ما طلبت سجل المدرسة2020.xls

وعليكم السلام -على الرغم انك لم تقم برفع ملف موضح فيه كل المطلوب الا انك يمكنك استخدام هذا Public Function XLookup(ByVal vTable As Variant, _ ByVal vResult As Variant, _ ParamArray vKeyVals() As Variant) As Variant Const cRoutine As String = "XLookup" Dim oLo As ListObject 'Table containing data Dim vKeys As Variant 'vKeyVals internal version Dim sCol As String 'Column Address Range to search Dim vKey As Variant 'Key(s) to find in Column(s) Dim lKey As Long 'Current key Dim lRow As Long 'Found Row Dim lCol As Long 'Found Column Dim sAddTxt As String 'Additional Error Text ' Error Handling Initialization On Error GoTo ErrHandler Set XLookup = Nothing ' Check Inputs and Requisites ' Table Select Case TypeName(vTable) Case Is = "ListObject": Set oLo = vTable Case Is = "Range": Set oLo = vTable.ListObject Case Else: Set oLo = ActiveSheet.Evaluate(vTable).ListObject End Select ' Return Column If TypeName(vResult) = "Range" Then vResult = vResult.Value2 ' Search Keys If UBound(vKeyVals) = -1 Then Err.Raise DspError, , "#Key(s) required" ' When called by VBA, ParamArrays sometimes are stuffed in the first element If IsArray(vKeyVals(LBound(vKeyVals))) Then _ vKeys = vKeyVals(LBound(vKeyVals)) Else _ vKeys = vKeyVals ' Procedure With oLo If Not .DataBodyRange Is Nothing Then ' Just 1 key - Use Worksheet.Function because it is fastest w/1 Key If LBound(vKeys) = UBound(vKeys) Then vKey = vKeys(UBound(vKeys)) If IsNumeric(vKey) Then vKey = CDbl(vKey) lRow = Application.WorksheetFunction.Match( _ vKey, _ .ListColumns(1).DataBodyRange, _ 0) ' More than 1 key - Use Worksheet.Evaluation because it is fastest w/multiple keys Else ' Concatenate Key Values and Search Column Addresses For lKey = LBound(vKeys) To UBound(vKeys) lCol = lCol + 1 sCol = IIf(sCol <> vbNullString, sCol & " & ", vbNullString) & _ .ListColumns(lCol).DataBodyRange.Address ' Determine Key Value If TypeName(vKeys(lKey)) = "Range" Then _ vKey = vKey & vKeys(lKey).Value2 Else _ If IsDate(vKeys(lKey)) Then _ vKey = vKey & CLng(vKeys(lKey)) Else _ vKey = vKey & vKeys(lKey) Next ' Find Row # by Evaluating MATCH within the Table's worksheet lRow = .Parent.Evaluate("=Match(""" & vKey & """," & sCol & ",0)") End If ' Get Column # lCol = .ListColumns(vResult).Index ' Return result Set XLookup = .ListRows(lRow).Range(lCol) End If End With ErrHandler: If Err.Number > 0 Then ' Create sAddTxt (Additional Error Text) if needed Select Case Err.Number Case Is = 9: sAddTxt = "Column " & vResult & " not found in " & oLo.Name Case Is = 13, 1004: sAddTxt = "Key(s) " & Join(vKeys, ",") & " not found" Case Is = 424: sAddTxt = "Table not found" End Select ' Customize Errors based on UDF of VBA caller If TypeName(Application.Caller) = "Range" Then 'Called from UDF MLookup = CVErr(xlErrRef) Debug.Print cRoutine & ":" & Err.Description & vbLf & sAddTxt Else 'Called from VBA (most likely) Select Case Err.Number Case Is = 13, 1004: 'Key(s) not found. Log Error Debug.Print cRoutine & Err.Description & vbLf & sAddTxt Case Else: 'Pop Up Error Message Select Case DspErrMsg(cModule & "." & cRoutine, sAddTxt) Case Is = vbAbort: Stop: Resume 'Debug mode - Trace Case Is = vbRetry: Resume 'Try again Case Is = vbIgnore: 'End routine End Select End Select End If End If End Function أو يمكنك مشاهدة هذا الرابط Custom Excel XLOOKUP Function أو هذا الرابط UDF: XLOOKUP – Using VLOOKUP for left AND right searches وهذا ايضا فيديو للشرح https://www.youtube.com/watch?v=Tbqh4_HcUlI

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

جرب هذا طبعا بعد اذن الأستاذ الرائد , فممكن ان تكون هذه مشكلة من عندك فملف الأستاذ الرائد يعمل بكفاءة عموماً -تفضل تم التعديل على نفس اكوادك شششششش1.xlsm

لا أستطيع الاختيار الا اذا وردت فى جملة كاملة

أحسنت استاذ منير عمل ممتاز وشرح وافى وكافى

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

هلا اخي تفضل TEST5.accdb

اجعل تنسيق الخلايا هكذا [$-2000000]0

بارك الله فيك استاذنا الكريم وجزاك الله كل خير

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

وعليكم السلام-فقط عليك بإستخدام هذه المعادلة بالتنسيقات الشرطية =OR($E7="الجمعة",$E7="السبت") Condation Fromat.xlsx

السلام عليكم ورحمة الله وبركاته هل يوجد كود برمجي يمنع فك حماية محرر الاكواد؟ اي عندما يحاول برنامج كسر حماية محرر الاكواد الكود البرمجي يعمل الاتي: يحذف الشيت.

في نفس السياف ، سالني صديق نفس السؤال تقريبا علي إميلي الخاص وأرسل لي أيضا ملف تيكست به أكثر من 90,000 رقم تليفون كلها بالسعودية مثل 966503011273 966505584504 966503932916 966500477498 وكان طلبه: 1. ترتيب الارقام في جهات اتصال vCard ، بحيث ترتب الارقام تصاعديا من الاصغر إلى الاكبر 2. ثم تأخذ كل جهة اتصال اسما تسلسليا يبدأ من J00001 الحقيقة أن كثرة الأسماء ، جعلتني أفكر في وسيلة أخري والحمد لله باستخدام كود صغير يمكن إنشاء عدد كبييير من ملفات الـ vcf التي يمكن قرائتها من الأوتلوك أو من المحمول وبعد إذن صديقي ، سأستعير بعض أرقام التليفونات في الملف المرفق وبه الشرح فقط تضع في ملف الإكسل الإسم بالعمود الأول ثم الرقم بالعمود الثاني وتشغل الكود فينشيء لك عدد الكروت الـ vcf المطلوب في المجلد xxx علي القرص D الكود هو Sub write_VCF() LR = [A999999].End(xlUp).Row For i = 1 To LR a = Cells(i, 1): b = "TEL;CELL" & Cells(i, 2) Filename = "D:\xxx\" & a & ".vcf" Open Filename For Output As 1 Print #1, "BEGIN: VCARD" Print #1, "FN: " & a Print #1, b Print #1, "End: VCARD" Close #1 Next i End Sub والآن أترككم مع المرفق تحويل الأسماء.rar