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

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

  1. Ali Mohamed Ali

    Ali Mohamed Ali

    المشرفين السابقين


    • نقاط

      20

    • Posts

      11651


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

    سليم حاصبيا

    أوفيسنا


    • نقاط

      13

    • Posts

      8723


  3. omar elhosseini

    omar elhosseini

    المشرفين السابقين


    • نقاط

      9

    • Posts

      1950


  4. Shivan Kurdi

    Shivan Kurdi

    الخبراء


    • نقاط

      8

    • Posts

      3493


Popular Content

Showing content with the highest reputation on 01/15/20 in مشاركات

  1. لا تحفظ الملف بصيغة ( xlsx ) بل احفظ الملف بأحد هذين الصيغ xlsm or xlsb
    3 points
  2. وعليكم السلام-فقط عليك استخدام هذه المعادلة =SUMIF($A:$A,$D2,$B:$B) اجمالي كمية بنفس التاريخ1.xlsx
    3 points
  3. حرب هذا الماكرو Option Explicit Sub get_my_studiants() Application.ScreenUpdating = False Dim A As Worksheet Dim B As Worksheet Set A = Sheets("ALL_STD") Set B = Sheets("B") Dim col%, r, x, LB LB = B.Cells(Rows.Count, "B").End(3).Row If LB < 5 Then LB = 5 B.Range("a5").Resize(LB - 4, 6).Clear Dim my_clas$: my_clas = B.Range("e2") Dim my_mad$: my_mad = B.Range("K2").Value If my_clas = "" Or my_mad = "" Then GoTo Exit_Sub col = A.Rows(1).Find(my_clas, lookat:=1).Column r = A.Columns(1).Find(my_mad, lookat:=1).Row x = Application.CountIf(A.Columns(1), my_mad) B.Range("b5").Resize(x).Value = _ A.Cells(r, 2).Resize(x).Value B.Range("c5").Resize(x, 3).Value = _ A.Cells(r, col).Resize(x, 3).Value With B.Range("A5").Resize(LB - 4, 6) .Columns(1).Formula = "=if(B5="""","""",max($A$4:a4)+1)" .Columns(1).Interior.ColorIndex = 6 .Borders.LineStyle = 1 .Columns(6).Formula = "=RANK(E5,$E$5:$E$29,0)+COUNTIF($E5:E$5,E5)" .Value = .Value .Font.Size = 26 .Font.Bold = True .InsertIndent 1 End With Exit_Sub: Application.ScreenUpdating = True End Sub الملف مرفق My_students.xlsm
    3 points
  4. أ.عماد محمد عبد العزيز جرب المرفق عسى أن يكون المطلوب مع مراعاة أن 2020 ستتغير كل عام .. أم أنك تريدها ثابته التوريد.accdb معذرة أخى Shivan Rekany لم أنتبه لردك
    3 points
  5. هذه ملف لشرح الطباعه معاينة الطباعه.xlsm
    2 points
  6. نعم ممكن ولكن في حالة كثرة السجلات مثل مثالك يحتاج وقت وايضا كفاءة جهاز الكمبيوتر ..... انظر المرفق هذا ما تريد تم تعديل المرفق .... Desktop1.rar
    2 points
  7. وعليكم السلام اهلا بك في منتداك اتفضل اليك هذا استعلام الجدولي TRANSFORM Min([111].[الحالة]) AS MinOfالحالة SELECT [111].[رقم] FROM 111 GROUP BY [111].[رقم] PIVOT [111].[السنة]; مع المرفق ask access.rar تقبل تحياتنا
    2 points
  8. اهلا بك في منتداك نحن لا نعرف ماذا تريد بالاضبط لكن اتفضل اليك بعض روابط مختلفة سيكون فيها ما تريد ان شاء الله اليك هذا الموضوع تقدر تكبير وتصغير عناصر نموذج واليك هذا الرابط ايضا للاستاذ الشيخ صالح حمادي واليك هذا الرابط لاستاذ المصمم ابا جودي واليك هذا لتغير دقة الشاشة عندك حسب برامج تقبل تحياتنا
    2 points
  9. اتفضل القي نظرتا الى هذا تم استخدام هذا الكود مع اضافة حقل id باستخدام دالة dmax + 1 If IsNull(Me.Purchase__Order__No) = True Then Me.id = Nz(DMax("[id]", "Order"), 0) + 1 Me.Purchase__Order__No = Nz(DMax("id", "Order"), 0) + 1 & "/" & 2020 DoCmd.RunCommand acCmdSaveRecord Me.id.DefaultValue = Nz(DMax("[id]", "Order"), 0) + 1 End If التوريد-.mdb
    2 points
  10. تفضل وذلك بوضع هذا الكود فى حدث ThisWorkBook Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'Define your variables. Dim ws As Worksheet, EvalRange As Range 'Set the range where you want to prevent duplicate entries. Set EvalRange = Range("A1:a10000") 'If the cell where value was entered is not in the defined range, if the value pasted is larger than a single cell, 'or if no value was entered in the cell, then exit the macro. If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub If IsEmpty(Target) Then Exit Sub 'If the value entered already exists in the defined range on the current worksheet, throw an 'error message and undo the entry. If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then MsgBox Target.Value & " already exists on this sheet." Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If 'Check the other worksheets in the workbook. For Each ws In Worksheets With ws If .Name <> Target.Parent.Name Then 'If the value entered already exists in the defined range on the current worksheet, throw an 'error message and undo the entry. If WorksheetFunction.CountIf(Sheets(.Name).Range("A1:a10000"), Target.Value) > 0 Then MsgBox Target.Value & " already exists on the sheet named " & .Name & ".", _ 16, "No duplicates allowed in " & EvalRange.Address(0, 0) & "." Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit For End If End If End With Next ws End Sub عدم تكرار المدخلات - 1.xlsm
    2 points
  11. اسف جدا كثرة الملفات علي .... انظر المرفق الجديد ..... تم تعديل المرفق .....اسف مرة أخرى QR_code_-name.mdb
    1 point
  12. مثال جميل استاذ @أحمد الفلاحجى واستاذنا الفاضل رضا استخدم مفتاح اساس ثلاثي وهذا كان رأيي في ردي على الاستاذ @ابوصلاح في الموضوع السابق تحياتي وتقديري
    1 point
  13. جرب هاذا الكود معاينة طباعة مع امكانية الطباعه.rar
    1 point
  14. هل هذا المطلوب استعلام تحديث لاعمدة القائمة المنسدلة.accdb
    1 point
  15. أستاذ Gamor أين الضغط على الإعجاب على هذه الإجابة الممتازة وهذا اقل ما يقدم لصاحب الفضل بعد ربنا فى حل مشكلتك ؟! 💙
    1 point
  16. اخي الماكرو يعمل بسلاسه ولا توجد به مشاكل لجميع نسخ الاكسيل ونسخ الويندوز هل قمت بتمكين الماكر ...؟ ارجو من بعض الاخوة تجربة الملف شاهد فيديو للملف الملف مره اخري بصيغة xlsm Test_1.rar Video_1.rar
    1 point
  17. رحم الله والديك ربي يسعدك ويرزقك دنيا واخره
    1 point
  18. في الاعدادات الغي علامة صح امام هذه المربعات
    1 point
  19. كان عليك لزاما استخدام خاصية البحث فى المنتدى فبه العديد من الموضوعات التى تحول المعادلات الى اكواد ومنها : تحويل معادلة الى كود
    1 point
  20. الازرار حسب ما اعرفه لا يمكن , لكن تقدر تعمل حذف ريكورد مثلا عند ضغط دبل كليلك مثلا على احد الحقول
    1 point
  21. اريد انشاء استعلام يوضح الارباح الحقيقية للمطبعة مع اخذ البيانات التالية بعين الاعتبار :- 1- مرجع المشتريات - 2- مرجع المبيعات - 3 - المصاريف التشغيلية - 4 - البضاعة المتبقية في المخازن معادلة الربح : اجمالي الربح = تكلفة المبيعات - تكلفة المشتريات + بضاعة اخر المدة تكلفة المبيعات = المبيعات - الخصم المسموح به - مرجع المبيعات تكلفة المشتريات = المشتريات - الخصم المكتسب - مرجع المشتريات بضاعة اخر المدة = بضاعة اول المدة + اجمالي المشتريات " المشتريات - مرجع المشتريات " - اجمالي المبيعات " المبيعات - مرجع المبيعات ارجو مساعدتي للضرورة وجزاكم الله عنا خير الجزاء ادارة محل1.rar
    1 point
  22. شاهد المرفق Test_1.xls
    1 point
  23. السلام عليكم تم تعديل الروابط فى المشاركة الأولى التى كانت بها خطأ لقدم الموضوع و تغير تنسيق الروابط مع مرور الزمن و ذلك بناء على تنبيه الأخ أحمد الفلاحجي برسالة و الأخ بوسف بالموضوع مع الشكر و التقدير
    1 point
  24. وعليكم السلام اتفضل اخى عسى ان اكون فهمت طلبك يوضع الكود التالى فى حدث عند الفتح او التحميل docmd.Maximize بالتوفيق ان شاء الله 3-7-0.rar
    1 point
  25. جرب هذا الكود (حدد البوكس ثم انتقل الى اي خلية او اضغط Enter) Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) tesl End Sub '+++++++++++++++++++++++++++++ Sub tesl() Dim cb As CheckBox, n For Each cb In Me.CheckBoxes cb.TopLeftCell.Offset(1, -1).NumberFormat = _ IIf(cb.Value <> 1, ";;;", "General") Next cb End Sub الملف مرفق( شيت Key) TEST_xxx (3).xlsm
    1 point
  26. تم التعديل على الملف السابق كما تريد بالضبط .... وهذا حل اخر ان اردت يمكنك ذلك من خلال قائمة Data ثم تختار Subtotal إدراج صف تلقائى - 1.xlsm
    1 point
  27. تفضل يمكنك وضع استخدام هذا الكود بحدث الصفحة , بحيث يقوم بإدراج صف فارغ بمجرد إدخال تاريخ مختلف Private Sub Worksheet_Change(ByVal Target As Range) Dim L& If Target.Address = Cells(Rows.Count, 5).End(xlUp).Address Then If IsDate(Target) And IsDate(Target(0)) Then If Target.Value2 <> Target(0).Value2 Then Application.EnableEvents = False Application.ScreenUpdating = False Target.EntireRow.Insert If IsEmpty(Target(-2)) Then L = Target(-1).Row Else L = Application.Max(6, Target(-1).End(xlUp).Row) With Target(0).EntireRow .Interior.ColorIndex = 4 .Interior.Pattern = xlSolid .Columns("B:C").Formula = "=SUM(B" & L & ":B" & Target(-1).Row & ")" .Cells(4).Value2 = "إجمالى اليوم " End With Application.ScreenUpdating = True Application.EnableEvents = True End If End If End If End Sub إدراج صف تلقائى - 1.xlsm
    1 point
  28. الاخ khairi ali علي الله توكلت سأبدأ العمل ولكني لا احيذ المفاجأت في الطلبات بعد بدء العمل علي الموضوع فهل هناك اي طلبات او تعليمات اخري الله المستعان لقد تم عمل اللازم بنجاح ولكنك دخلت المنتدي ولم تكلف نفسك بالرد شكرا لك تفضل اخي شاهد المرفق Test_1.xls
    1 point
  29. 1 point
  30. اهلا وسهلا استاذي ابو بسملة الحقيقة الطريقة التي استخدمها تختلف قليلا عن هذه الطريق وان كانت تشترك معها في استخدام اكواد او وسوم xml الطريقة متعبة وتحتاج الى معرفة بهذة الوسوم او على الاقل المعرفة بلغة ترميز النصوص المتشعبة html الخاصة ببناء صفحات الانترنت لوجود تشابه بينهما طريقتي باختصار كتابة الوسوم ووضع id لكل امر اما طريقة تنفيذ الامر فعن طريق وحدة نمطية مع ان النتيجة رائعة الا ان الطريقة متعبة جدا وسوف احاول بعون الله ان اضع موضوع يشرح الطريقة واعتذر اذاكان الرد غير مفيد واستعير عبارة جميلة لاخي واستاذي الفاضل @essam rabea "انا راجل عجوز" فانا فعلا رجل عحوز والشروحات مرهقة جدا
    1 point
  31. السلام عليكم هذا ملف فيه كود تنبيه TIMER يظهر لك وميض للتنبيه قبل 5 ايام وكذلك بعد 5 ايام من انتهاء المدة (ويمكن تغيير المدة حسب العمل)) ويمكن اظافة رسالة تنبيه له تحياتي test.rar
    1 point
  32. جرب هذا الملف Max_min_special_Final.xlsx
    1 point
  33. وعليكم السلام اخى الفاضل عود نفسك دائما مع كل سؤال ارفق مثال لما لديك حتى يتثنى لاخوانك واساتذتنا مساعدتك بشكل افضل واسرع اطلع على الرابط التالى لعلك تجد به ما تتمناه واستخدم البحث هتلاقى امثله كتير عن ذلك بالتوفيق اخى
    1 point
  34. تم علاج المشكلة كنت بدأت العمل علي ذلك لأني توقعت سؤالك عن ذلك في المساء ان شاء الله شاهد المرفق !_example_32.rar
    1 point
  35. 1-لا تجعل الخلية L1 فارغة ولا تحتوي على اسم اي شيت 2-اذا كان النطاق من L2 و نزولاً فارغاً الكود يأخذ كل الصفحات وإلا الصفحات المحددة في هذا النطاق 3-عدم ترك خلايا فارغة بين اسماء الشيتات المطلوبة في العامود L تفضل الكود المطلوب Option Explicit Private Sub Worksheet_Activate() Application.EnableEvents = False fil_data_val Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$2" And Target.Count = 1 Then Call find_Please(Me, Range("a2")) End If Application.EnableEvents = True End Sub '++++++++++++++++++++++++++++ Sub find_Please(SH As Worksheet, Rg) Dim Principal As Worksheet Dim Ro% 'first found row Dim ACT_Ro% 'Actual row All Others found rows Dim m%: m = 4 Dim My_rg As Range 'find range with Criteria in cell(A2) Dim Mon_Array SH.Range("A4:F" & Rows.Count).Clear Set Principal = Sheets("serch") Mon_Array = Application.Transpose(Range("L2", Range("L1").End(4))) If UBound(Mon_Array) > Sheets.Count Then For Each SH In Sheets If SH.Name = Principal.Name Then GoTo Next_sh Set My_rg = SH.Range("C:C").Find(Rg, lookat:=1) If My_rg Is Nothing Then GoTo Next_sh Ro = My_rg.Row: ACT_Ro = Ro Do Principal.Cells(m, 1).Resize(, 5).Value = _ SH.Cells(ACT_Ro, 1).Resize(, 5).Value Principal.Cells(m, 6) = SH.Name m = m + 1 Set My_rg = SH.Range("C:C").FindNext(My_rg) ACT_Ro = My_rg.Row If ACT_Ro = Ro Then Exit Do Loop Next_sh: Next Else '================================================ For Each SH In Sheets If SH.Name = Principal.Name Then GoTo Next_sh1 If Application.CountIf(Principal.Range("L2:L50"), SH.Name) <> 0 Then Set My_rg = SH.Range("C:C").Find(Rg, lookat:=1) If My_rg Is Nothing Then GoTo Next_sh1 Ro = My_rg.Row: ACT_Ro = Ro Do Principal.Cells(m, 1).Resize(, 5).Value = _ SH.Cells(ACT_Ro, 1).Resize(, 5).Value Principal.Cells(m, 6) = SH.Name m = m + 1 Set My_rg = SH.Range("C:C").FindNext(My_rg) ACT_Ro = My_rg.Row If ACT_Ro = Ro Then Exit Do Loop End If Next_sh1: Next '==================================== End If If m = 4 Then _ MsgBox "Current Account Not Found": Exit Sub With Principal.Range("A4:F" & m - 1) .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 24 .HorizontalAlignment = 2 .VerticalAlignment = 2 .Interior.ColorIndex = 24 .InsertIndent 1 End With End Sub '++++++++++++++++++++++++++++ Sub fil_data_val() Dim S As Worksheet, T As Worksheet Dim dic As Object Dim i% Set S = Sheets("serch") Set dic = CreateObject("Scripting.Dictionary") For Each T In Sheets If T.Name = S.Name Then GoTo Next_T i = 2 Do Until T.Range("c" & i) = vbNullString dic(T.Range("C" & i).Value) = vbNullString i = i + 1 Loop Next_T: Next T With S.Range("A2").Validation .Delete .Add 3, Formula1:=Application.Transpose(Join(dic.keys, ",")) End With dic.RemoveAll: Set dic = Nothing Set T = Nothing: Set S = Nothing End Sub الملف مرفق Saerch_by_Special_sheets.xlsm
    1 point
  36. في هذاه الحالة يلزم هذا الكود Option Explicit Private Sub Worksheet_Activate() Application.EnableEvents = False fil_data_val Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$2" And Target.Count = 1 Then Call find_Please(Me, Range("a2")) End If Application.EnableEvents = True End Sub '++++++++++++++++++++++++++++ Sub find_Please(SH As Worksheet, Rg) Dim Principal As Worksheet Dim Ro% 'first found row Dim Ro_Atc% 'All Others found rows Dim m%: m = 4 Dim My_rg As Range 'find range with Criteria in cell(A2) SH.Range("A4:E" & Rows.Count).Clear Set Principal = Sheets("serch") For Each SH In Sheets If SH.Name <> Principal.Name Then Set My_rg = SH.Range("C:C").Find(Rg, lookat:=1) If My_rg Is Nothing Then GoTo Next_sh Ro = My_rg.Row: Ro_Atc = Ro Do Principal.Cells(m, 1).Resize(, 5).Value = _ SH.Cells(Ro_Atc, 1).Resize(, 5).Value m = m + 1 Set My_rg = SH.Range("C:C").FindNext(My_rg) Ro_Atc = My_rg.Row If Ro_Atc = Ro Then Exit Do Loop End If Next_sh: Next If m = 4 Then _ MsgBox "Current Account Not Found": Exit Sub With Principal.Range("A4:E" & m - 1) .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 24 .HorizontalAlignment = 2 .VerticalAlignment = 2 .Interior.ColorIndex = 24 .InsertIndent 1 End With End Sub '++++++++++++++++++++++++++++ Sub fil_data_val() Dim S As Worksheet, T As Worksheet Dim dic As Object Dim i% Set S = Sheets("serch") Set dic = CreateObject("Scripting.Dictionary") For Each T In Sheets If T.Name = S.Name Then GoTo Next_T i = 2 Do Until T.Range("c" & i) = vbNullString dic(T.Range("C" & i).Value) = vbNullString i = i + 1 Loop Next_T: Next T With S.Range("A2").Validation .Delete .Add 3, Formula1:=Application.Transpose(Join(dic.keys, ",")) End With dic.RemoveAll: Set dic = Nothing Set T = Nothing: Set S = Nothing End Sub الملف مرفق Search_Account _repetitions.xlsm
    1 point
  37. تسلم استاذ سليم الكود عملي - ومفيد جدا اطلب رجاء اضافة الى الكود جلب المكرر في حالة وجوده في الشيت اكون شاكر
    1 point
  38. الاخ sam_farh جرب هذا المرفق مع ملاحظة ان : البرنامج يعمل في بيئة وندوز 32 بت و لا يعمل في بيئة وندوز 64 بت !_Auto HD Serial Number.rar
    1 point
  39. كي تعمل معك القائمة المنسدلة غادر الصفحة وعد اليها مجدداً
    1 point
  40. السلام عليكم - تسلم - جزيت خيرا غيرت بالكود ليناسب عملي وجعلت البحث على اساس خلية A بدل C ولكن توجد مشكلة بالقائمة المنسدلة - مرة تعمل ومرة لا تعمل
    1 point
  41. ان شاء الله سيكون لي نصيب من الخير سأرفق كود رائع لعمل اللجان والكود خاص بالعلامه عبد الله باقشير كشف مناداة بالكود.rar
    1 point
  42. وعليكم السلام ورحمة الله وبركاته وكل عام وانت واهل المنتدى الكرام بخير وبعد فكره تجمبع الملفات التي وضعها اخي المحترم الاستاذ محمدي عبد السميع قكره مفيده ولكن نطلب من احد المشرفين الكبار ان يضيف هذا الملف في المشاركات الاولى ويكتب تجميع الملفات لغايه تاريخ 25/7/2014 ستكون اكثر فائده من فنح موضوع جديد
    1 point
  43. لماذا تختلف الاحصائيات بتغيير الدالة ؟ ******************** الاجابه للاستاذ القدير عبد الله باقشير السلام عليكم السبب وجود نص في نطاق الارقام وهو الحرف غ دالة SUMPRODUCT ضف فيها شرط للتحقق من وجود رقم لتتم المقارنة =SUMPRODUCT((ISNUMBER($F$3:$F$642))*($F$3:$F$642>=3.2)*($E$3:$E$642="مسلم")) وايضا دالة الصفيف اضف فيها شرط للتحقق من وجود رقم لتتم المقارنة =SUM((ISNUMBER($F$3:$F$642))*($F$3:$F$642>=3.2)*($E$3:$E$642="مسلم")) في امان الله
    1 point
  44. بسم الله الرحمن الرحيم الحمد لله الواحد القهار، العزيز الغفار،مكور الليل على النهار ، تذكرة لأولي القلوب والأبصار وتبصرة لذوي الألباب والاعتبار ، الذي أيقظ من خلقه من اصطفاه فزهدهم في هذه الدار، وشغلهم بمراقبته وإدامة الأفكار ، وملازمة الاتعاظ والادكار، ووفقهم للدؤوب في طاعته والتأهب لدار القرار، والحذر مما يسخطه ويوجب دار البوار، والمحافظة على ذلك مع تغاير الأحوال والأطوار. أحمده أبلغ حمد وأزكاه، وأشمله وأنماه. أما بعد: رأيت أن أقدم عملا خالصا لوجه الله الكريم لعل الله يتغمدنا برحمته ولذا رأيت أن أجمع الأكواد بطريقة منظمة تسهل للجميع الحصول عليها عند استخدام محرك البحث ، ولهذا ساقدم سلسلة من الأكواد كل كود بعنوان واضح يسهل الوصول له في موضوع مستقل وسأشرح كيفية استخدام الكود ماتيسر لي إن شاء الله وعلى الله قصد السبيل ****************************************** الكود الاول هذا كود يجعل صفحة الاكسيل عندما تكتب فيها تكتب باللغة العربيه دائما حتى ولو كانت لغة الكتابة في لوحة المفاتيح انجليزي طريقة الاستفادة من الكود افتح ملف اكسيل اضغط على الرز ALT وانت ضاغط على الزر اضغط على F11 الموجود أعلا لوحة المفاتيح ستظهر شاشة الماكرو اضغط على This Workbook ستجد Private Sub Workbook_Open() hosami "00000401", 1 End Sub انسخه والصقة في ملفك الجديد في نفس الموقع This Workbook ثم اضغط على موديول 1 سيتم فتح الموديول هذا Declare Function hosami Lib _ "user32" Alias "LoadKeyboardLayoutA" (ByVal A As String _ , ByVal B As Long) As Long انسخه وضعه في نفس المكان وهو موديول 1 في ملفك الجديد احفظ الملف واعد فتحه ولاحظ لغة الكتابه في لوحة المفاتيح ودمتم في حفظ الله تغيير لغة الكي بورد الى العربي.rar تغيير لغة الكي بورد الى العربي بطريقة اخرى.rar
    1 point
  45. هذا المثال يختبر وجود ملف فى المسار c:\officena.txt فاذا لم يجده يغلق القاعدة و يظهر رسالة و اذا وجده يقوم باظهار رسائل بالمكتوب داخل الملف و يتم اضافته فى حدث form load للنموذج الافتتاحي للبرنامج Private Sub Form_Load() On Error GoTo ERROR_SUB Open "c:\officena.txt" For Input As #1 Do While Not EOF(1) Line Input #1, xx MsgBox Trim(xx) Loop Close #1 Exit Sub ERROR_SUB: If Err.Number = 53 Then MsgBox " No Autorization - This Program Is Not Authorized ! " + Chr(13) + Chr(10) + "Do not do this Again !!", vbCritical, "Alert Message " Close #1 DoCmd.Quit End If End Sub
    1 point
  46. أخي العزيز هذه أول مشاركاتي في الموقع وهو كود استخدمه في برامجي وأنا مستعد للتعاون مع أي أخ لدية مشكلة Private Sub Form_Current() Dim myfile, chpass myfile = Dir("c:\windows\filename.txt") If myfile <> "" Then Else chpass = MsgBox("نسخة غير مرخصة") DoCmd.Quit End If End Sub
    1 point
  47. مرفق مثال فتح النموذج و التقرير بكل سجلاته أو مع عمل تصفية علي السجل المختار من النموذج فقط اختار موظف ثم اضغط علي زر فتح النموذج أو التقرير للموظف المحدد أيضا يوجد مثال علي عمل تجميع للتقرير للدورات التي حصل عليها كل موظف علي حدة خاصية Sorting and grouping من وضع تصميم التقرير و استخدام الدالة count لعد دورات كل موظف و ايضا عمل مسلسل للتقرير عن طريق وضع =1 فى مصدر البيانات لمربع نص و اختيار خاصية Runnig Sum - Overall مرفق المثال OpenSpecific.rar
    1 point
  48. مرفق مثال به خياران تفعيل السجل الاخير تفعيل السجل الذي يليه ( سجل جديد) بعد الاختيار من كومبو مع تحياتي SubFormgoToLast.rar
    1 point
  49. برنامج لادارة حلقات التحفيظ نسخة 2000 ونسخة اكس بي و هو بصيغة mde ALMaher.txt
    1 point
×
×
  • اضف...

Important Information