اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

  1. Gamal.Saad

    Gamal.Saad

    الخبراء


    • نقاط

      10

    • Posts

      211


  2. سليم حاصبيا

    سليم حاصبيا

    أوفيسنا


    • نقاط

      9

    • Posts

      8,723


  3. jjafferr

    jjafferr

    أوفيسنا


    • نقاط

      6

    • Posts

      9,724


  4. الرائد77

    الرائد77

    الخبراء


    • نقاط

      6

    • Posts

      238


Popular Content

Showing content with the highest reputation on 23 ماي, 2020 in all areas

  1. الظاهر انكم موديل قديم وما ادري اما انا فمن جماعة Amiga 1000 ، يعني ايام 286 🙂 جعفر
    3 points
  2. ياهلا بالاستاذ جمال نعم رحلة طويلة قبل حتى اقراص 5.25 كانت الاقراص 8.25 ثم بعد فترة نزلت اقراص 5.25 ثم 3.5 ما اشرت اليه كانت بدايتي مع انظمة ميكروسوفت واجهزة البي سي الشخصية ولدي قبلها تجربة مع اجهزة Mainframe وكذلك نظام UNIX وهو الاساس للانظمة الحديثة من اصدارات Linux ومشتقاته صحيح كلامك وكان اكبر هدية للمستخدم العربي قبل الويندوز برنامج اسمه النافذة كان يسمح باستخدام اللغة العربية في قواعد داتابيس 1 و 2 و كذلك في برنامج لوتس 123 وهو برنامج جداول ممتدة شعبيتة على الدوس مثل شعبية اكسل و برنامج libre calc من LibreOffice في الوقت الحالي الان التقنية تطورت بشكل كبير ومثل ما اختفت الاقراص المرنة سوف تختفي اقراص hd خصوصا ان اسعار ssd و m.2 اصبحت في متناول العديد من المستخدمين اول هارد ركبتة كان حجمة 20 ميجابايت وكان ثورة مقابل اقراص 3.5 بحجم 720 كيلوبايت وبحد اقصى 1.44 ميجا بايت للاقراص عالية الكثافة و2.88 ميجا قبل انتهاء زمنها 2.88 يتعطل اكثر مما يعمل
    3 points
  3. الاخوة الاساتذة الافاضل كل عام وحضراتكم بكل خير احببت مشاركتكم هذه المجموعة الجميلة من الازرار التى تستخدم بالفورم وهى تجميع من مشاركات الاساتذة بالمنتدى احترامى اخيكم New_Microsoft_Excel_Worksheet.xlsx المجموعة2 ازرار.xls
    2 points
  4. تفضل انتبه اخي قلت من a1 وو في الجدول الفعلي في ورقتك a9 لذلك هذا الكود يقوم بالاززاحة الى الاعلى ابتداءا من الخلية a1 و لا يحذف الصف كاملا اذا اردتت البدء من a9 غير في الكود Private Sub CommandButton2_Click() On Error Resume Next With Range("a1:d32") .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp End With End Sub تواتي 15.xlsm
    2 points
  5. تفضل Private Sub CommandButton2_Click() On Error Resume Next With Range("b9:b10000") .SpecialCells(xlCellTypeBlanks).EntireRow.Delete End With End Sub تواتي 15.xlsm
    2 points
  6. نعم اخي العزيز @احمد الفلاحجي تم المطلوب بالتمام والكمال والاستعلام اشتغل حتى في الفيجوال بيسك الحقيقة لا أجد كلمات تعبر عن مدى شكري وامتناني لحضرتك وربما لا يوجد أبلغ من أن أقول جزاك الله خيرا وبارك فيك ويسر لك فعل الخير دائما وأبدا والشكر موصول للأخ @فايز..على جهوده الكبيرة واهتمامه باجابة الاستفسار ولجميع الاخوة المشاركين مع خالص تقديري وامتناني
    2 points
  7. لا داعي لاي شيء فقط قم باخفاء الأعمدة التي لا تريدها مستعملاً هذا الماكرو Sub Hide_columns() Dim k% Sheets("Infos").Columns.Hidden = False Dim arr() arr = Array(3, 4, 5, 6, 7, 8, 9, 10) For k = LBound(arr) To UBound(arr) Sheets("Infos").Columns(arr(k)).Hidden = True Next End Sub في الصورة المرفقة حدد أرقام الأعمدة التي تريد اخفا ئها من خلال Array (تسلسل الأرقام داخل Array غير ضروري) Information_Advanced_Ar_date_1.xlsm
    2 points
  8. وعليكم السلام-يمكنك فقط استخدام هذه المعادلة =IFERROR(VLOOKUP(G3,$A$3:$C$200,3),"") قائمة تسديد 1TEST.xlsx
    2 points
  9. مشاركة مع الاخوة الاحبة ..... عسى أن يكون الكود قصيرا .... تفضل Aziz (2).rar
    2 points
  10. طبعا تضيف criteria معايير وشروط التنفيذ : =DCount("num_m7_tsd";"cargoo";" [startdate] = forms!copy_ff!startdate AND [time] > [Forms]![copy_ff]![time1] AND [time] < [Forms]![copy_ff]![time2]") dcount_where_date_time.accdb
    2 points
  11. برنامج الموارد البشرية HR "مفتوح المصدر" يحتوى على التالي : -بيانات الموظف . -الإجازات . - الأذنونات . - تسجيل الحضور يدوياً . - الخصومات . - السلف . - المكافأت . - تقيييم الموظف . - ساعات إضافية . - تقارير. - متابعة الحضور والانصراف . - تسجل الحضور والانصراف بشكل آلي . - تسجل الحضور بشكل يدوي . وخيارات أخرى . وهذا البرامج من تطويري وجدت جداوله في موقع خارجي . لا تنسونا من خالص الدعاء ،،، HR.rar
    1 point
  12. غير في هذا السطر For i = 1 To Sheets.Count حييث 1 يمثل الورقة 1 مثلا For i = 2 To 5 اي من الورقة 2 الى الورقة 5 غير حسب ما تريد
    1 point
  13. كلنا ذلك الرجل لذا لدي في جهازي 10 اقراص صلبة مستقلة ليست مقسمة ولكون اللوحة الام تدعم فقط 7 اقراص واحد m.2 بمنفذ خاص للويندوز 10 وسته اقراص من نوع ساتا 3 والبقية باستخدام محول pci to sata يسمح بتركيب 8 اقراص اضافية لا اخي جمال انت حديث جدا لكونك استخدمت 486 تكون بدايتك من عام 1989 تاريخ انطلاق هذه السلسلة والتي انتهت عام 1993 باطلاق الجيل الاول من معالجات بنتيوم الشرف لنا استاذ جمال وعيدكم مبارك
    1 point
  14. جرب هذا الكود Private Sub CommandButton2_Click() On Error Resume Next Range("a9").Resize(9).SpecialCells(4) _ .EntireRow.Delete Shift:=xlUp End Sub
    1 point
  15. جرب هذا بعد التعديل تواتي 15) fini (1).xlsm
    1 point
  16. أخي التواتي . كان يجب التوضيح من الاول بأن هناك معادلات مع طلبك .ليتم اجابتك بسرعة .لعدم ضياع الوقت تفضل حبيبي الملف النهائي الازاحة الى الاعلى و ازاحة الخلايا التي تحنوي على المعادلات معها تواتي 15) fini.xlsm
    1 point
  17. اخى قد يفيدك هذا الموضوع احترامى
    1 point
  18. الحمدلله الذى بنعمته تتم الصالحات وجزاه الله خيرا اخى @فايز.. واخى @أمير2008 واخوانى واساتذتى الذين نتعلم منهم كل يوم بالتوفيق اخوانى
    1 point
  19. يالتوفيق أخي عدنان ولا تنس الضغط على أفضل إجابة .
    1 point
  20. ياااااااه سيادتك محظوظ أنك كنت في البدايات دي وتاريخ لا ينسي أهم شيئ عندي في وسائط التخزين مش مساحة تخزينهم وإنما عددهم ههههه وكل ما تزيد النسخ الاحتياطية عندي على اقراص التخزين تقل الكوابيس الليلية لأن عندي عقدة من فقدان الداتا هههههه سيادتك أقدم برضو ، أنا حضرت 486 والله سعيد وتشرفت بمعرفتكم استاذ kha9009lid واستاذ jjafferr
    1 point
  21. اخى @ازهر عبد العزيز هل هذا ما تريد ع مثال اخى واستاذى @ابو تراب جزاه الله خيرا عندك النموذج الاساسى وعدلت تاريخين ليوم 20/5 جرب عليه وعندك النموذج الاخر frmcompare لاظهار جميع السجلات ثم التصفيه بناء على التاريخ بالتوفيق اخى New Microsoft Access Database (5) - Copy(2).accdb
    1 point
  22. السلام عليكم تم التعديل على قيم العمود A (بالمعادلات) من الورقة 111 (ورقة البيانات) والتعديل على كود "طباعة الكل" بما يفي الغرض المطلوب... برنامج شهادات نصف التيرم صف ثانى.xls
    1 point
  23. فعلا عملاق .. هههههههههههههههه
    1 point
  24. اهلا بك اخى ومرحب بعودتك للمشاركه معنا وخفف عن نفسك وانسى الماضى واستغفر لنفسك ولهم ولا تنسانا بارك الله فيك وكلنا اخوه فالله قبل كل شىء تجمعنا هنا من اجل هدف واحد وهو ان نتعلم ونستفيد ونفيد اخواننا فى الله بما من الله علينا من فضله وعلمه بارك الله فيك ومرحبا بعودتك مره اخرى اخى 💐 وتقبل الله منكم صالح الاعمال ونعود للمشاركه مع اخى @فايز.. و سؤال الاخ @adnan gharbi انظر المرفق ووافنا بالنتيجه بالتوفيق الاستعلام المطلوب.accdb
    1 point
  25. جميل جدا واستعلام واحد شيئ ملفت للنظر ربما لأني تركت الأكسس منذ فترة وأستأذنكم في طرح حل آخر ولا يهم إن كان المطلوب أم لا لأن غرضي من الطرح هو التعلم من سؤال عن إمكانية اختصار أربعة استعلامات صممتها للوصول للشكل بملف الوورد الذي أرفقه السائل - طبعا كثير وأربعة استعلامات أخرى لمطلوب لم يطلبه السائل هههههههه وقد استعنت بدالة من هذا المنتدى لعمل المطلوب الغير مطلوب Vibrators3.accdb
    1 point
  26. وعليكم السلام -اجعل المعادلة هكذا =IFERROR(E12-E13,"") معادلة1.xlsx
    1 point
  27. هذه مشكلة تقريب ، وبالمناسبة فهي مشكلة غريبة جدا للدالة Round المفترض أن : Round(82.5, 0) تساوي 83 لكن الدالة تعطي 82 في مشكلة غير مفهومة للأرقام الزوجية التي يصاحبها رقم خمسة بعد العلامة العشرية على العموم تم الحل باضافة 0.1+ Dynamic Array and form controls up 2.accdb
    1 point
  28. اللهم نور قلبه بنور الايمان وتقبل منه صالح الاعمال وزد في حسناته ياذا الطول والكمال.
    1 point
  29. نعم نعم أعتذر خطأ غير مقصود لأن القسمة كانت تتم على العدد المفترض للمقررات + 1 وهذا غير صحيح وتم التعديل بإزالة +1 Dynamic Array and form controls update.accdb
    1 point
  30. ممتاز اخي الرائد حتى ولو كان عندي ملاحظة بسيطة من شأنها التسريع (للبيانات الكثيرة) 1 - الدالّة IFERROR في المعادلات الأفضل عدم استعمالها الا للضروروة لأنها تلزم الاكسل على حساب المعادلة واذا وجد خطأ يدرج فراغاً (مما يضيع الوقت سدى / جزء من الف من الثانية بالنسبة للحاسوب شيء كبير جداً / ) هذا بالإضافة الى ارهاق البرنامج بأشياء لا لزوم لها 2- الأفضل استعمال CountA لانه عندما رقم الصف يتجاوز الرقم المطلوب من خلال CountA يقوم اكسل بإدراج الفراغ ولا يفكر حتى بحساب نتيجة المعادلة 3- المعادلة المفترحة من عندي =IF(ROWS(B$4:B4)>COUNTA(A$4:A$1000),"",INDEX(A$4:A$1000,SMALL(IF(A$4:A$1000<>"",ROW(A$4:A$1000)-ROW(A$4)+1),ROWS(B$4:B4))))
    1 point
  31. رأس الصفحة Page Header يمكنك اخفاؤه برمجيا واظهاره في أي صفحة تريدها بكتابة الكود داخل التقرير من حدث تنسيق Format الكود التالي يخفي رأس الصفحة في جميع الصفحات : Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) PageHeaderSection.Visible = False End Sub ولإظهار رأس الصفحة في الصفحة الأولى فقط دون الباقي : Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) If Me.Page > 1 Then PageHeaderSection.Visible = false Else PageHeaderSection.Visible = true End If End Sub وممكن تختار رقم صفحة معينة
    1 point
  32. وعليكم السلام-جرب الملف هكذا Amr2.xlsx
    1 point
  33. عادي مفيش مشكلة بس التجميع هيكون : بدلاً من السيد/ أحمد ، العقيد/ وليد ، والوزير/ سيد ستجد : 4/ أحمد ، 14/وليد ، 22/ سيد لأن الجدول المشار إليه فيه أكواد الرتب أو اللقب وليس أسمائها ولحل مؤقت للمشكلة يجب تعديل الدالة وعمل ربط مع جدول آخر به كود اللقب واسم اللقب ، كما بالمرفق NewDB3.accdb
    1 point
  34. أولا أشكرك استاذي الغالي @jjafferr بارك الله فيك على سرعة الاستجابة ...... رحم الله والديك
    1 point
  35. هذه الاسطر من الكود يمكن ازالتها لانها تثقل البرنامج بدون منفعة(كانت للكود القديم) Dim Ar(4), Ar_Fasl(1 To 9) Dim t: t = Sheets(my_SHEET).Index Dim Start_row_B%: Dim Start_row_H% For i = 4 To 12 Ar_Fasl(i - 3) = CStr(But_Sheet.Cells(5, i)) Next Erase Ar: Erase Ar_Fasl
    1 point
  36. نطاق الفاتر مؤلف من 10 اعمدة من A الى J لذلك لا يوجد عامود رقم 22
    1 point
  37. تطوير بسيط على الكود ليكون بشكل أسرع بكثير معتمداً على الفلتر وليس الحلقات التكرارية المملة والمرهقة للبرنامج و اضافة الى ذلك ترقيم تلقائي للطلاب Option Explicit Sub get_Eleves_Names(ByVal my_SHEET As String) Rem ====>>>> Created By Salim Hasbaya On 27/6/2019 Application.ScreenUpdating = False '================================ Dim SH As Worksheet Dim ss% For Each SH In Sheets If SH.Name Like "*#*" Then ss = ss + 1 End If Next Set SH = Nothing '============================ Dim m As Worksheet: Set m = Sheets("Main") Dim But_Sheet As Worksheet: Set But_Sheet = Sheets(my_SHEET) But_Sheet.Range("K1") = ss: ss = 0 Dim Ar(4), Ar_Fasl(1 To 9) Dim t: t = Sheets(my_SHEET).Index Dim Start_row_B%: Dim Start_row_H% Dim mal$: mal = "ذكر" Dim fem$: fem = "انثى" Dim i% But_Sheet.Range("B10").Resize(500, 5).ClearContents But_Sheet.Range("H10").Resize(500, 5).ClearContents '======================================= Dim Filtred_rg As Range: Set Filtred_rg = m.Range("a1").CurrentRegion Dim FinaL_row%: FinaL_row = Filtred_rg.Rows.Count For i = 4 To 12 Ar_Fasl(i - 3) = CStr(But_Sheet.Cells(5, i)) Next With Filtred_rg .AutoFilter 2, mal .Columns(8).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("B10") .Columns(7).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("d10") .Columns(1).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("e10") .Columns(3).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("f10") End With '======================================= With Filtred_rg .AutoFilter 2, fem .Columns(8).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("h10") .Columns(7).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("j10") .Columns(1).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("k10") .Columns(3).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(xlCellTypeVisible).Copy But_Sheet.Range("L10") End With Start_row_B = But_Sheet.Cells(Rows.Count, "B").End(3).Row Start_row_H = But_Sheet.Cells(Rows.Count, "H").End(3).Row But_Sheet.Range("c10").Resize(Start_row_B - 9) = _ Application.Transpose(Ar_Fasl(t - 1)) But_Sheet.Range("i10").Resize(Start_row_H - 9) = _ Application.Transpose(Ar_Fasl(t - 1)) But_Sheet.Columns("A:L").AutoFit '================================ If Sheets("Main").FilterMode Then _ Sheets("Main").ShowAllData: Filtred_rg.AutoFilter Set m = Nothing: Set But_Sheet = Nothing Erase Ar: Erase Ar_Fasl Application.ScreenUpdating = True End Sub '================================================== Sub EXTACCT_NAME() Dim Impt Dim x% Impt = InputBox("Please Give_me the sheet's name to transfer data" & _ Chr(10) & "Write the sheet's name Without Cotes") If UCase(Impt) = "MAIN" Then MsgBox "I can't Change the values of Principal Sheet" Exit Sub End If On Error Resume Next x = Len(Sheets(Impt).Name) If x = 0 Then On Error GoTo 0 MsgBox "The Sheet: " & Impt & " Not Existes" Exit Sub End If Call get_Eleves_Names(Impt) End Sub الملف من جديد Mes_Eleves_Super.xlsm
    1 point
  38. باختصار ان اسم المشروع مشابه لأسم الامر فلذلك يظهر الخطأ انظر الشرح المطول في هذا الموضوع ......
    1 point
  39. اتفضل هذا حسب طلبك Dim dbOther As DAO.Database Dim rs1 As DAO.Recordset Dim dbCurrent As DAO.Database Dim rs2 As DAO.Recordset Dim intI As Integer On Error GoTo ErrorHandler If IsNull(Me.txtImportFile) Then MsgBox "عذرا اخي الكريم ... لم تقم بإختيار قاعدة البيانات الخارجية", vbInformation, "تبيه" DoCmd.CancelEvent Me.txtImportFile.SetFocus Else Set dbOther = OpenDatabase(txtImportFile) Set rs1 = dbOther.OpenRecordset("Table", dbOpenDynaset) Set dbCurrent = CurrentDb Set rs2 = dbCurrent.OpenRecordset("Table", dbOpenDynaset) If rs1.EOF Then Exit Sub intI = 1 rs1.MoveFirst Do While Not rs1.EOF With rs2 .AddNew !Name = rs1![Name] !Id = rs1![Id] !tel = rs1![tel] !country = rs1![country] .Update rs1.MoveNext intI = intI + 1 End With Loop MsgBox (" تم نقل " & intI - 1 & " سجل "), vbInformation, "تبيه" MsgBox "تم تحديث بيانات جداول القاعدة الخارجية بنجاح", vbInformation, "تبيه" End If rs1.Close Set dbOther = Nothing rs2.Close Set dbCurrent = Nothing Exit Sub ErrorHandler: ' MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
    1 point
  40. اتفضل اتمنى يكون كما طلبت Dim dbOther As DAO.Database Dim rs1 As DAO.Recordset Dim dbCurrent As DAO.Database Dim rs2 As DAO.Recordset Dim intI As Integer On Error GoTo ErrorHandler If IsNull(Me.txtImportFile) Then MsgBox "عذرا اخي الكريم ... لم تقم بإختيار قاعدة البيانات الخارجية", vbInformation DoCmd.CancelEvent Me.txtImportFile.SetFocus Else Set dbOther = OpenDatabase(txtImportFile) Set rs1 = dbOther.OpenRecordset("Table", dbOpenDynaset) Set dbCurrent = CurrentDb Set rs2 = dbCurrent.OpenRecordset("Table", dbOpenDynaset) If rs1.EOF Then Exit Sub intI = 1 rs1.MoveFirst Do While Not rs1.EOF With rs2 .AddNew !Name = rs1![Name] !Id = rs1![Id] !tel = rs1![tel] !country = rs1![country] .Update rs1.MoveNext intI = intI + 1 End With Loop MsgBox "تم تحديث بيانات جداول القاعدة الخارجية بنجاح", vbInformation End If rs1.Close Set dbOther = Nothing rs2.Close Set dbCurrent = Nothing Exit Sub ErrorHandler: MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
    1 point
  41. السلام عليكم اضطررت عمل جدول مؤقت للموضوع ، وهناك طريقتين وضعتهم لك: 1. جدول مؤقت tbl_Balance في قاعدة البيانات ، بحيث يتم حذف البيانات القديمة منه ، ثم ادخال البيانات الجديدة اليه ، ونستخدم الاستعلام qry_Balance للتقرير ، وانا شخصيا لا احبذ وجود جدول مؤقت داخل قاعدة البيانات ، لأنه يجعل حجم البرنامج يكبر ، الى ان بين كل فترة واخرى تضغط على زر الاصلاح Compact and Repair ، 2. جدول مؤقت خارج البرنامج (في مجلد Temp الوندوز) ، وكل ماله علاقة بهذه الطريقة يحمل رقم2 ، والتقرير2 يأخذ مصدره من هذا الجدول المؤقت ، ولا يستخدم الاستعلام qry_Balance. جعفر 597.2.Test2.accdb.zip
    1 point
  42. وعليكم السلام اولا ، ارفق لك تغيير جدا طفيف ، وهو لتوقيف الخطأ اذا لم يكن هناك سجلات ، ثانيا ، المعادلة التي تفضلت بها غير عن المعادلة التي ارفقتها انا ، فما ادري اذا انت عملت تغيير آخر كذلك ّّ والافضل انك ترفق برنامجك الذي اعطاك الخطأ. Option Compare Database Public B As Long Public x() Public B2() Function Bal(ID, C, D) On Error GoTo err_Bal 'C = Cash 'D = Depo 'Do this for entry to the Function If B = 0 Then 'asign a Zero value to x(), 'we will need this so that the Function will NOT repeat 'going over the old records over and over due to scrolling the Query up and down Dim rst As DAo.Recordset Set rst = CurrentDb.OpenRecordset("SELECT * FROM Qry_Cust_Deno_Depo WHERE [Receipt Date]=" & DateFormat([Forms]![Search]![MyDate])) rst.MoveLast: rst.MoveFirst RC = rst.RecordCount ReDim x(RC) ReDim B2(RC) For i = 1 To RC x(rst![Receipt Number]) = 0 rst.MoveNext Next i rst.Close: Set rst = Nothing End If If x(ID) = 0 Then '1st entry asigns values C = Replace(C, "-", 0) D = Replace(D, "-", 0) B = C + B - D Bal = B x(ID) = 1 B2(ID) = B Else 'for further visits, just take the already asigned value Bal = B2(ID) End If Exit_Bal: Exit Function err_Bal: If Err.Number = 3021 Then Resume Exit_Bal Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function Function DateFormat(varDate As Variant) As String 'Purpose: Return a delimited string in the date format used natively by JET SQL. 'Argument: A date/time value. 'Note: Returns just the date format if the argument has no time component, ' or a date/time format if it does. 'Author: Allen Browne. allen@allenbrowne.com, June 2006. ' 'calling the Function: DateFormat(The_Date_Field) 'a = dlookup("[some field]","some table","[id]=" & me.id & " And DateFormat(The_Date_Field)") ' If IsDate(varDate) Then If DateValue(varDate) = varDate Then DateFormat = Format$(varDate, "\#mm\/dd\/yyyy\#") Else DateFormat = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#") End If End If End Function جعفر 597.1.Test2.accdb.zip
    1 point
  43. شكرا على تنبيهي على هذا الخطأ هناك تغييرين في البرنامج ، 1. في الاستعلام ، فارسلنا رقم الوصل ايضا الى الوحدة النمطية ، 2. وهذه الوحدة النمطية الجديدة: Option Compare Database Public B As Long Public x() Public B2() Function Bal(ID, C, D) 'C = Cash 'D = Depo 'Do this for entry to the Function If B = 0 Then 'asign a Zero value to x(), 'we will need this so that the Function will NOT repeat 'going over the old records over and over due to scrolling the Query up and down Dim rst As DAo.Recordset Set rst = CurrentDb.OpenRecordset("SELECT * FROM Qry_Cust_Deno_Depo WHERE [Receipt Date]=#" & [Forms]![Search]![MyDate] & "#") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount ReDim x(RC) ReDim B2(RC) For i = 1 To RC x(rst![Receipt Number]) = 0 rst.MoveNext Next i rst.Close: Set rst = Nothing End If If x(ID) = 0 Then '1st entry asigns values C = Replace(C, "-", 0) D = Replace(D, "-", 0) B = C + B - D Bal = B x(ID) = 1 B2(ID) = B Else 'for further visits, just take the already asigned value Bal = B2(ID) End If End Function جعفر 597.1.Test2.accdb.zip
    1 point
  44. السلام عليكم هذا الكود ما نفعش معاك Sub Mail_workbook_1() 'Working in 97-2007 Dim wb As Workbook Set wb = ActiveWorkbook If Val(Application.Version) >= 12 Then If wb.FileFormat = 51 And wb.HasVBProject = True Then MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _ "Save the file first as xlsm and then try the macro again.", vbInformation Exit Sub End If End If On Error Resume Next wb.SendMail "", _ "This is the Subject line" On Error GoTo 0 End Sub وهو منقول من ملف عندي خاص بارسال ايميل فيه نفس الكود الذي تريد تعديله المرفق 2003 SendMail(Attachment)Testers.rar
    1 point
  45. أعزائي تم وضع ملف إرسال ملف الاكسل بالايميل عن طريق الاكسل بالمرفقات برجاء الاطلاع و الاستفادة شكرا SendMail_Attachment_Testers.rar
    1 point
×
×
  • اضف...

Important Information