Jump to content
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

Leaderboard

Popular Content

Showing content with the highest reputation on 09/16/2020 in all areas

  1. جرب هذا الكود( بدون معادلات) Option Explicit Dim My_formula$ Dim Ar(), i% Dim Ar1() Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$4" _ And Target <> "" And Target.Count = 1 Then vl_formula End If Application.EnableEvents = True End Sub '++++++++++++++++++++++++++++++++++++++ Sub vl_formula() My_formula = "=IFERROR(VLOOKUP(A4,id!A4:P500,2,0),"""")" Ar = Array(2, 3, 12, 13, 15, 8, 14, _ 6, 5, 4, 7, 10, 9, 11) Ar1 = Array("C5", "G5", "C7", "E7", "G7", _ "C9", "E9", "G9", "C11", "E11", "G11",
    2 points
  2. تفضل التعديل اخي الكريم Up_عقود.rar
    2 points
  3. السلام عليكم أعتقد أن هناك خطأ في القيمة 0.44 التي وضعتَها والصحيح هو 0.73... ومعذرة على الخطأ الذي اقترفتُه في ملفي السابق عند حساب المتوسط الكلي للعينات و الانحراف المعياري الكلي... بن علية حاجي الإحصاء 22.xlsx
    2 points
  4. وبسطر واحد : DoCmd.GoToControl Screen.PreviousControl.Name جعفر
    1 point
  5. اللي فهمته : عندك الحقل A , وخرجت منه الى الكومبوبوكس ، وبعدين تريد ترجع مرة ثانية من الكومبوبوكس الى الحقل A : هذا الكود يكون في احد احداث الكومبوبوكس : Dim ctrl As Control Set ctrl = Screen.PreviousControl DoCmd.GoToControl ctrl.Name واذا تريده بدلا من DoCmd.CancelEvent If IsNull([Namee]) Then MsgBox "لاتترك الحقل فارغاً **هذا الحقل اجباري ** ادخل الاسم الرباعي", vbCritical + vbMsgBoxRight, "تحذير ..!!" 'DoCmd.CancelEvent Dim ctrl As Control Set ctrl = Screen.PreviousControl DoCmd.GoToControl ctrl.Name End If جعف
    1 point
  6. تفضل (إن كنت قد فهمت ما تريد)... تحويل الدقائق.xls
    1 point
  7. السلام عليكم 🙂 لو تتبع هذه الطريقة ، ما تتعب 🙂 جعفر
    1 point
  8. شكرا استاذ ازهر وشكرا يادكتور كاف يعطيكم الف عافيه وفقكم الله لما يحبه ويرضاه
    1 point
  9. تفضل هذا التعديل اخي الكريم ( اكتشفت خطأ في حساب التاريخ حيث تم التعديل ليحسب من التاريخ الحالي للنظام ) Up_عقود_2.rar
    1 point
  10. تفضل هذه مشاركة من طرفي اخي طلال لكي تتعدد امامك الحلول و تختار الانسب منها المشاريع.rar
    1 point
  11. السلام عليكم هو شيت بسيط لا يحتوي الا على معادلتين تم ارفاق الملف مدعوم بشرح واتمني ان يكون الشرح وافي نسخة من خدمة شؤون الموظفين.xlsx
    1 point
  12. غير خاصية LimitToList / الالتزام بالقائمة الى yes تحياتي
    1 point
  13. قبل كل شيء ازالة الحلايا المدمجة من الملف
    1 point
  14. وعليكم السلام توضيحnn.rar
    1 point
  15. الف مبروك ... الاخ العزيز جعفر وانتمنى ان اشوف جميع المشتركين فى الموقع خبراء
    1 point
  16. تفضل اخي الكريم Private Sub city_NotInList(NewData As String, Response As Integer) Dim ctl As Control Dim strSQL As String Set ctl = Me!city If MsgBox(" اسم المدينة" & " / " & _ Me.city.Text & " / ليس ضمن القائمة هل تريد إضافته ", _ vbOKCancel, "officena") = vbOK Then Response = acDataErrAdded strSQL = "INSERT INTO tbl_city(city) VALUES('" strSQL = strSQL & NewData & "');" CurrentDb.Execute strSQL MsgBox "تمت الاضافة ", , "officena" Else Response = acDataErrContinue ctl.Un
    1 point
  17. تأكد من السؤال قبل طرحه اين يوجد اكثر او أقل من 5 مرات
    1 point
  18. يمكن ان يكون المطلوب SABAH.xlsx
    1 point
  19. جرب هذا الكود اخي الكريم مع العلم بأن مسار قاعدة البيانات الحالية يكون بهذا الشكل مسار قاعدة البيانات الحالية MyPath=CurrentProject.Path لمعرفة اسم قاعدة البيانات الحالية CurrentProject.FullName الأن نبدء بالكود الخاص بنسخ الملف - اضف مربع نص و لنجعل اسمه xFile - اضف ازرار و اعطه اسم FileDialog أو اي اسم تريده و ضع الكود التالي في حدث عند النقر لاختيار الملف المراد نسخه Dim Addfile As Object Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "All Files", "*.*" If .Show
    1 point
  20. أستاذ tiger2016 الكود يعمل على كل خلايا ورقة العمل إذا كانت بها معادلات تم عمل كود ترحيل باسم ahmed أعتقد أنه يفي الغرض شيت فاتورة مبيعات A - 2 - Copy.xlsm
    1 point
  21. السلام عليكم نصيحة اخي ابتعد عن الديكورات والالوان لانه سيجعل برنامجك تقيلا وركز على الجوهر قبل المظهر ولا باس بالالوان الخفيفة البسيطة هذا اولا. ثانيا وجدت فورم بالمنتدى خزنته منذ مدة واعتقد انه للسيد العيدروس جزاه الله خيرا فيه طلبك بالتمام والكمال ان شاء الله اذا كان الفورم يحقق طلبك الغي جميع اوامر الطباعة بالصفحات لان الفورم يقوم بعملها الزرين في صفحة الطباعة المحددة هي اوامر الطباعة طبعا لم اجرب الطباعة لانه ليس لذي طابعة وانا نقلت الفورم الى ملفك فقط واي خطأ بالنتائج فليس بمقدوري اصلاحه وستجد المعونة من الخبراء ان شاء الله برنامج طباعة الشهايد.xlsb
    1 point
  22. لم افهم ماذا تقصد بعبارة لو يكون الرنج في العامود K أوسع اذا كان فصدك توزيع المواد على عدة حلايا فهذا الملف (صفحة Salim ) يفي بالغرض Aboomar_1.xlsm
    1 point
  23. ربما ينفع هذا الكود Option Explicit Sub del_Data_Val() Range("Data_Val").Validation.Delete '++++++++++Optional+++++++++++ Range("Data_Val").Value = "" End Sub '++++++++++++++++++++++++++++++++++++++ Sub Ad_Data_Val() With Range("Data_Val").Validation .Delete .Add 3, Formula1:="=Source_Rg" End With '++++++++++Optional+++++++++++ Range("Data_Val") = "" End Sub لك حرية ان تبقي على القيم الموجودة او لا بمسح ما يوجد داخل المربع الاحمر حسب هذه الصورة الملف مرفق Talal.xlsm
    1 point
  24. جرب هذا الكود Option Explicit Sub get_Std() Dim rg As Range, Cel As Range Dim Where As Range Dim dic As Object, ky, m Dim COl As Collection Set Where = Range("J4").CurrentRegion If Where.Rows.Count > 1 Then Where.Offset(1). _ Resize(Where.Rows.Count - 1) _ .ClearContents End If Set rg = Range("A4").CurrentRegion If rg.Rows.Count = 1 Then Exit Sub Set rg = rg.Offset(1).Resize(rg.Rows.Count - 1) Set dic = CreateObject("Scripting.Dictionary") Set COl = New Collection For Each Cel In rg.Columns(3).Cells If Cel <> vbNullString Then dic(Cel.Value) = dic
    1 point
  25. السلام عليكم زيادة في الخير هذا كود كنت كتبته , ليس بروعة كود استاذنا ياسر فهو يحتاج لجدول من الاكسيل و لا يعتمد علي نفسه. تحياتي abjad+.rar
    1 point
  26. وعليكم السلام أخي الغالي خالد الرشيدي لكم يسعدني ويشرفني مرورك العطر بالموضوع ومشكور على كلماتك الرقيقة تقبل تحياتي
    1 point
  27. أخي الفاضل أبو لجين إليك الدالة التالية وإن شاء الله تفي بالغرض بالنسبة لأي طلب جديد لا يخص هذا الطلب يرجى طرح موضوع مستقل Function CalString(sInp As String) As Long Static bInit As Boolean Dim asMap() As String Dim asLtr() As String Dim I As Long Static aiVal(0 To 255) As Long If Not bInit Then asMap = Split("1 1 1 1 1 1 2 3 4 5 6 7 8 9 10 20 30 40 50 60 70 80 90 100 200 300 400 500 600 700 800 900 1000") asLtr = Split("ء أ إ آ ا ئ ب ج د ه و ز ح ط ي ك ل م ن س ع ف ص ق ر ش ت ـة ث خ ذ ض ظ غ") For I = 0 To UBound(asMap) aiVal(Asc(asLtr(
    1 point


×
×
  • Create New...