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

وجدت هذا الملف منشور على النت يبدو لي من النظرة المبدئية أن الملف سهل ممتنع ، يقوم بحساب و رسم الشبكة بطريقة المسار الحرج بناء على التقدير ثلاثي النطاق و يمكن عدم تطبيق التقدير ثلاثي النقاط بوضح الزمن مباشرة فى عمود زمن النشاط (L) بدلا من المعادلة التي تحسبه يناء على التقدير المتشاءم و المتفائل و الاكثر توقعها critical-path-method.xlsx المصدر

try this file WiAAM.xlsx

جرب هكذا وهناك ايضا فيديو لشرح عملية التحويل للأستاذة ساجدة العزاوى لها منا كل الإحترام ج100 كيف نجعل كود 32 بت يعمل على 64 بت وعدم ظهور خطأ ptrsafe اكسل vba ساجدة العزاوي تحويل64بيت.xlsb

يمكن الاستعانة بهذه المعادلة =IF(COUNTIF(A4:A10; F4:F10 );"";F4:F10) ملف الاسم.xlsx

افتح المرفق واكتب جزء من اسم الصف ثم دبل كلك عليه وانظر ... Barna_765.accdb

حياك الله اخي علي

تفضل ..... ali (2).zip

حياك الله ..... انظر المرفق واضغط على موظف_جديد في الكمبوبكس ولاحظ Barna.accdb

بارك الله فيك أخي الكريم

Function CalcAge(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAge = vYears & "سنة, " & vMonths & "شهر, " & vDays & "يوم" End Function صحح كود الوحدة النمطيه لأن الكود الذي ارفقة أخي ناقل في بدايتة ونهايتة نقص احرف سبب عدم الاجابة : قد يكون المطلوب غير واضح للزملاء يجب فتح موضوع مستقل بطلبك ارفاق مثال مبسط للمطلوب لانك طلبت في موضوع قديم جدا حاول التقيد بهذه القوانين أخي الكريم ... وحياك الله قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف

لانك لم تضف الوحدة النمطيه .... انشأ وحدة نمطية واحفظها ثم اانشأ الاستعلام بارك الله فيك او ارفق لنا مثال مصغر للتعديل عليه ؟؟؟؟؟؟؟؟؟

وعليكم السلام أخي الكريم انس ...... حياك الله في المنتدى لو ارفقت مثال لما تريد لكان للاعضاء اكثر قدرة في مساعدتك ....

استخدم نفس كود االاستاذ @ناقل واعمل استعلام للجدول لديك ثم ضيف هذه العبارة الى الاستعلام مع تغيير ما يلزم من مسميات Expr1: CalcAge([from_date];[to_date])

انا اعمل على نظام ويندوز 10 64 بت الكود يظهر الفورم لفترة وجيزة ثم يختفي يعمل ولا مشكلة معي

ABO.xlsm

وعليكم السلام-لا يمكن عمل ما تريد ولكن يمكن كما تعلم مشاركة ملف الإكسيل لأكثر من شخص شرح مشاركة جدول اكسل للتعديل مع أكثر من شخص عن بعد Excel| انترنت أو شبكة داخلية

May be? الصيغة الاصلية للكشف البنكي.xlsm

هذه العلامه <> يعني غير متساوي مع NZ هذه الدالة بيعمل لك تغير قيمة اذا كان لا شيء الی القيمة اللي تكتب في اخره اي معنی جملة كاملة هو ان لا يكون متساوي مع حقل اللي في نموذج اللي اسمه تحويل العملات و اسم الحقل اي مربع نصي تحويل من واذا كان حقل تحويل من بيكون لاشي غير قيمة الحقل الی صفر تحياتي

حياك الله وبالتوفيق ,,,,,

بعد اذن الاخ أبو البشر هذا الكود ( لا يسمح بتكرار الأسماء) Option Explicit Sub test() Dim i% Dim Obj As Object Set Obj = CreateObject("Scripting.Dictionary") Sheets("re").Cells(12, 1).Resize(15, 3).ClearContents i = 3 With Sheets("الجمعة") Do While .Cells(i, 3).Value <> "" If .Cells(i, 2) <> vbNullString Then Obj(.Cells(i, 3).Value) = vbNullString End If i = i + 1 Loop End With If Obj.Count Then With Sheets("re").Cells(12, 2).Resize(Obj.Count) .Value = Application.Transpose(Obj.keys) .Offset(, -1) = Evaluate("Row(1:" & Obj.Count & ")") End With End If Set Obj = Nothing End Sub

كان وضعت مثال للتطبيق .... على كل حال جرب الكود التالي .... أو ارفق ملفك للتعديل . On Error Resume Next If IsNull(Me.readtbl.Column(0)) Then MsgBox "The List Empty or Items in list not selected", vbCritical, "Caution" Exit Sub End If Me.ProgBar.Visible = True Dim x As Integer For x = x To 30000 Me.ProgBar.Value = x If x = 30000 Then Me.ProgBar.Visible = False End If Next x Dim i As Integer Dim tbl As String Dim SDest As String Dim SFileName As String SDest = Me.txtPath SFileName = Me.txtFileName For i = 0 To Me.readtbl.ListCount - 1 If Me.readtbl.Selected(i) = True Then tbl = Me.readtbl.Column(0, i) DoCmd.TransferSpreadsheet acExport, , tbl, SDest & "\" & SFileName & ".xlsx" End If Next i MsgBox "تم بحمد الله الانتهاء من عملية التصدير ", 0 + 64 + 1572864, "مبروك"

بعد اذن الاخ علي لا يتم الترتيب الا اذا 1-كان هناك بيانات في الأعمدة B / C / D ( الترقيم لا ضرورة له لانه يتم اوتوماتيكياً) 2- تمت الكتابة في اول صف غير فارغ Option Explicit Dim RG As Range, Ro '++++++++++++++++++++++++++++++++++ Private Sub Worksheet_Change(ByVal Salim As Range) Set RG = Range("A2").CurrentRegion Ro = RG.Rows.Count With Application .EnableEvents = False .Calculation = xlCalculationManual .ScreenUpdating = False End With If Ro = 1 Then GoTo Bay_Bay If Salim.Row = Ro + 1 And _ Application.CountA(Cells(Salim.Row, 2) _ .Resize(, 3)) = 3 Then RG.Sort Range("D2"), 2, Header:=1 With RG.Offset(1).Resize(Ro - 1) .Columns(1) = Evaluate("row(1:" & Ro - 1 & ")") .HorizontalAlignment = 1 .InsertIndent 1 .Font.Size = 18 .Font.Bold = True .Borders.LineStyle = 1 End With End If Bay_Bay: With Application .EnableEvents = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub الملف مرفق Auto_sort.xlsm

وعليكم السلام يمكنك هذا ,بوضع ذلك الكود بحدث الصفحة Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("d:d")) Is Nothing Then Range("d1").Sort Key1:=Range("d2"), _ Order1:=xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End If End Sub فرز حسب 1الاكبر.xlsm

تفضل هذا الكود شامل الشرح اخي الكريم On Error GoTo errorhandle Dim MyFilePath, MyRange, MyTablName As String 'MyFilePath = "مسار ملف الاكسل" MyRange = "نطاق الخلايا المراد استيرادها من ملف الاكسل" MyTablName = "اسم الجدول الذي سيتم تخزين البياناته به" '-------------------------------- '''''''' فتح مستعرض الملفات لإختيار الملف '''''''' Dim fpath As Variant With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Add "Excel Files", "*.xls ; *.xlsx" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then MyFilePath = .SelectedItems(1) End If End With '-------------------------------- '''''''' استيراد ملف الاكسل حسب الشروط اعلاه '''''''' DoCmd.TransferSpreadsheet acImport, 10, MyTablName, FilePath, False, MyRange MsgBox "تم استيراد الملف بنجاح", vbMsgBoxRight + vbInformation, "تأكيد" errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description Resume errorhandleexit

مرفق لكم قواعد اللغة الفرنسية نسال الله أن يجزى صانع العمل خير الجزاء Grammaire-francais.rar

السلام عليكم بما ان أخي شفان جاء بكود اخونا أبو ابراهيم الغامدي ، فاليك التغيير المطلوب لحل مشكلتك: Function GetNumbersOnly(SText) Dim Numbers if len(SText & "")=0 then GetNumbersOnly="" exit function end if For i = 1 To Len(SText) If IsNumeric(Mid(SText, i, 1)) Then Numbers = Numbers & Mid(SText, i, 1) End If Next GetNumbersOnly = Trim(Numbers) End Function جعفر

الیک ھذا تم الحصول علیە من احد مشاركات استاذنا @أبو إبراهيم الغامدي اعمل كوبي باست لهذا الكود الى وحدة نمطية Function GetNumbersOnly(SText) Dim Numbers For i = 1 To Len(SText) If IsNumeric(Mid(SText, i, 1)) Then Numbers = Numbers & Mid(SText, i, 1) End If Next GetNumbersOnly = Trim(Numbers) End Function وفي استعلام اكتب هذا ارقام فقط: GetNumbersOnly([اسم_الحقل])

جزانا واياكم استاذ حسين مامون