اذهب الي المحتوي
أوفيسنا

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


Popular Content

Showing content with the highest reputation since 16 ينا, 2020 in all areas

  1. 5 points
    جرب الكتابة داخل المربع الأول وانظر النتيجة .... ايقاف علامة جدولة.accdb
  2. 4 points
  3. 3 points
    وعليكم السلام ورحمة الله وبركاته تفضل يا غالي Option Compare Database Option Explicit Dim X1 As Boolean Private Sub GroupHeader0_Format(Cancel As Integer, FormatCount As Integer) If X1 Then Detail.BackColor = 16777199 Else Detail.BackColor = 14877777 End If X1 = Not (X1) End Sub UP-db1.mdb تحياتي
  4. 3 points
    جرب هذا الماكرو Option Explicit Sub ABSCENT() Application.Calculation = xlCalculationManual Dim K As Worksheet, A As Worksheet Dim Ro_K%, col%, Ro_A%, i%, m%, t%: t = 1 Dim ALL$, ALPHA$, Str$: Str = "غ" ALL$ = " ": ALPHA = " " Set K = Sheets("keab"): Set A = Sheets("arhkeab") Ro_K = K.Cells(Rows.Count, 2).End(3).Row If Ro_K < 5 Then Exit Sub Ro_A = A.Cells(Rows.Count, 2).End(3).Row m = IIf(Ro_A < 5, 5, Ro_A + 2) For i = 5 To Ro_K If Application.CountIf(K.Cells(i, 6).Resize(1, 31), Str) = 0 Then _ GoTo My_next A.Cells(m, 2).Resize(, 2).Value = _ K.Cells(i, 2).Resize(, 2).Value For col = 6 To 36 If K.Cells(i, col) = Str Then ALL = ALL & Day(K.Cells(4, col)) & "-" ALPHA = ALPHA & K.Cells(3, col) & "-" t = t + 1 End If Next col If t > 1 Then With A.Cells(m, 4) .Value = Mid(ALL, 1, Len(ALL) - 1) .Offset(, 1) = Mid(ALPHA, 1, Len(ALPHA) - 1) .Offset(, 2) = t - 1 .Offset(, 3) = K.Cells(2, "Q") .Offset(, 4) = Year(Date) End With m = m + 1 End If My_next: t = 1 ALL = " ": ALPHA = " " Next i Application.Calculation = xlCalculationAutomatic End Sub الملف مرفق Tarhil_3iyab.xlsm
  5. 2 points
    ممكن تبدليه بهذا الكود Private Sub Worksheet_Selectionchange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select ElseIf Target.MergeCells = True And Target.HasFormula = True Then Target.Offset(0, 1).Select ElseIf ActiveCell.HasFormula = True And ActiveCell.MergeCells = True Then ActiveCell.Offset(0, 1).Select End If End Sub و بعذ إذن أستاذنا الفاضل سليم أرى أن يكون التعديل هكذا اكتب في السطر الذي قبل كلمة Dim في الماكرو ActiveSheet.Unprotect "123" واكتب في السطر الذي قبل كلمة End sub ActiveSheet.Protect "123" Option Explicit Sub get_my_studiants() Application.ScreenUpdating = False ActiveSheet.Unprotect "123" 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 ActiveSheet.Protect "123" End Sub My_students (1).xlsm
  6. 2 points
  7. 2 points
    وعليكم السلام ورحمة الله وبركاته ارفق مثال اخي الكريم لفهم المطلوب ولك الشكر تحياتي
  8. 2 points
    وعليكم السلام و رحمة الله و بركاته لان نموذجين الفرعي و رئيسي مربوطين بعلاقة عمودين id و Title احذف علاقة Title و تنحل المشكلة بإذن الله
  9. 2 points
    تفضل اخي العزيز ملف لاحد الاخوة في الموقع اتمنى ان يكون المطلوب Access Import_ up.rar
  10. 2 points
    تم التعديل عند فتح الملف خاصية ( الأزار المتحركة تكون فعله وخاصية ( طباعه الخلايا المحددة بالماوس فقط ) تكون معطله عندما تريد استخدام خاصية ( طباعه الخلايا المحددة بالماوس فقط ) قم بتفعيل ( تشك بوكس ) بنفس الشت شاهد المرفقات Test_3.rar بإذن الله سأحاول عمل ذلك لكن ما هي الورقة المعنية بتلك المهمة ( الرورقة التي تعطينا منها الرقم )
  11. 2 points
    بعد اذن اخى واستاذى @د.كاف يار اتفضل اخى وبالتوفيق ان شاء الله Pupil Names_UPDate.accdb
  12. 1 point
  13. 1 point
    بالاضافة الى ما تفضل به الاخوة الكرام ولهم الشكر من فضلك اخي الكريم @حلبي جرب معي الكود التالي يعمل بطريقة افضل من الاول Option Compare Database Private Sub Command1_Click() ' الشهر الحالي Dim X1, X2 As String X1 = Format(DateSerial(Year(Date), Month(Date), 1), "mm/dd/yyyy") X2 = Format(DateSerial(Year(Date), Month(Date) + 1, 0), "mm/dd/yyyy") myCriteria = "([T1].[COURSEDATE] between #" & X1 & "# and #" & X2 & "#)" Me.TSUB.Form.Filter = myCriteria Me.TSUB.Form.FilterOn = True End Sub Private Sub Command2_Click() ' الشهر السابق Dim X3, X4 As String X3 = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm/dd/yyyy") X4 = Format(DateSerial(Year(Date), Month(Date), 0), "mm/dd/yyyy") myCriteria = "([T1].[COURSEDATE] between #" & X3 & "# and #" & X4 & "#)" Me.TSUB.Form.Filter = myCriteria Me.TSUB.Form.FilterOn = True End Sub FILTER.rar تحياتي
  14. 1 point
  15. 1 point
    السلام عليكم استاذنا @عبد اللطيف سلوم استخدام الكود التالي هو الافضل للتعبير عن القيمة الفارغة (Null) . If Not IsNull(Me.رقم_القضية) Then Me.a.Visible = True End If تحياتي
  16. 1 point
    اخينا وحبيبنا ومعلمنا الغالي استاذ أحمد الفلاحجي " ابو بسملة " 😀 والله قد تعجز الكلمات على ان تعطيك قدرك 😀 ولاكن لا يسعني الا استعمالها لاوضوح صورة بسيطة عما في قلبي 😀 اللهم بارك له في ما تولى اعنه على ذلك وزد عليه من نعمك ...... اللهم آمين 😀 😀 تذكر دائما وابدا ان لك اخا في الله يدعو لك بظهر الغيب " اخوك - ابراهيم الهوبي من فلسطين " 😀
  17. 1 point
    وعليكم السلام نعم يمكن عمل كل شىء اخى باستخدام دوال التجميع هتجيب مبلغ الفاتوره بناء على رقم الفاتوره المتبقى سيتم خصم المدفوع ناقص الاجمالى والله اعلى واعلم وارفق لك مثالان لاخواننا واساتذتنا جزاهم الله خيرا لعلك تنتفع منهم وفضلا لا امرا ارفق مثال من عندك بالموضوع لان الصور وحدها لا تكفى تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق الرصيد.zip خصم من الرصيد.zip
  18. 1 point
    بارك الله فيك استاذنا العزيز أ محمد طاهر وجزاكم الله خيرا واعاننا الله واياكم على خدمه اخواننا كل التقدير والاحترام لشخصكم استاذى العزيز تمنياتى لك وللجميع بالتوفيق بارك الله فيك استاذ احمد @احمد بدره اعاننا الله واياكم اخى على خدمه اخواننا الكرام تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق
  19. 1 point
  20. 1 point
    استاذنا الكبير / @صالح حمادي اولا جزاكم الله خيرا على ما تفضلتم به فانتم احد اعمدة هذا الصرح العظيم لى عتاب صغير على حضراتكم ان كان مسموح لى وهو : نحن المبتدئين احيانا لا نفهم بعض المصطلحات مثل ـQR CODE وقد قرأت الموضوع ولا اعرف ما معنى هذا المصطلح وما فائدته (الفائدة هى من اسم العنوان تدعيم اللغة العربية) طب لماذا مع ان اللغه العربية موجودة في اكسس ارجو ان تتقبلوا كلامى وتتسع صدوركم لنا نحن المبتدئين انا واحد من الناس بحزن جدا عندما لا افهم او لا اعرف شئ امامى ارجو من سيادتكم التوضيح اكثر حتى نستفيد ويستفيد العامة .
  21. 1 point
  22. 1 point
    تم التعديل على الماكرو كما تريد Option Explicit Sub tranfere_data() Dim S As Worksheet, T As Worksheet Dim RGG5S As Range, RGB11S As Range, RGAS As Range Dim r%, x1%, x2% Set S = Sheets("SOURCE_SH"): Set T = Sheets("TARGET_SH") Set RGG5S = S.Range("G5").Resize(5) Set RGB11S = S.Range("B11").Resize(4) With T .Range("G6").Resize(5).ClearContents .Range("B12").Resize(4).ClearContents .Range("a18").Resize(18, 7).ClearContents .Rows.Hidden = False End With x1 = Application.CountA(RGG5S) x2 = Application.CountA(RGB11S) If x1 + x2 <> 9 Then MsgBox "Insufficient data in SOURCE_SH" & Chr(10) & _ RGG5S.Address & Chr(10) & "OR" & Chr(10) & _ RGB11S.Address Exit Sub End If Set RGAS = S.Range("A21").CurrentRegion.Columns(1) r = Application.CountA(RGAS) If r = 1 Then MsgBox "No data in SOURCE_SH to transfere" Exit Sub End If Set RGAS = S.Range("a22").Resize(r - 1, 7) With T .Range("G6").Resize(5).Value = RGG5S.Value .Range("B12").Resize(4).Value = RGB11S.Value .Range("A18").Resize(RGAS.Rows.Count, RGAS.Columns.Count).Value = RGAS.Value .Range("A18:A35").SpecialCells(4).EntireRow.Hidden = True End With End Sub
  23. 1 point
    تفضل على الرغم انك لم تقم برفع ملف مدعوم بشرح كافى عن المطلوب -فمن قوانين المنتدى لابد من رفع مثال لما تريد دائما فاتورة مبيعات وهذا ايضا فيديو شرح فاتورة الشراء والبيع وكيفية نقل الرقم من النموذج الى الجدول اكسس Access وهذا برنامج جاهز ايضا سوف يفيدك برنامج فواتير الشراء والبيع.rar
  24. 1 point
    قبل اول كلمة Dim في الماكرو اكتب هذا السطر و بذلك يقوم الماكرو بعمله حتى ولو كانت الورقة محمية ActiveSheet.Protect "123", UserInterfaceOnly:=1 ليصبح الماكرو بهذا الشكل Option Explicit Sub get_my_studiants() Application.ScreenUpdating = False '++++++++++++++++++++++++++++++++++++++++++++++++++++++ ActiveSheet.Protect "123", UserInterfaceOnly:=1 '++++++++++++++++++++++++++++++++++++++++++++++++++++ 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 End With Exit_Sub: Application.ScreenUpdating = True End Sub الملف مرفق My_students_Protected.xlsm
  25. 1 point
    بعد إذن أستاذنا الفاضل سليم لحماية المعادلات من العبث ممكن تضع هذا الكود في حدث ورقة العمل لمنع المستخدم من الوقوف على الخلية التي بها معادلة وبدون رقم سري جرب هذا Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select End If End Sub My_students (1).xlsm
  26. 1 point
    المشكلة لديك انت كما توقعت فيجب عليك تفعيل والتعليم على هذا الخيار ايضا وهو Trust Access
  27. 1 point
  28. 1 point
    و عليكم السلام و رحمة الله و بركاته هذا الاسم محجوز لعضو اخر لا يمكن استخدامه كاسم للدخول كما هو مذكور يمكنك تجربة اسماء اخري من اعدادت الحساب
  29. 1 point
    هل من الممكن يكون ان تظهر في الرساله نعم او لا في حالة الضغط على نعم لا يتم المسح واذا تم الضغط على لا يتم المسح ولك مني ارقى تحيه
  30. 1 point
    تفضل أخي Shell "mspaint.exe " & CurrentProject.Path & "\worker\" & [Worker] & ".jpg""", vbMaximizedFocus
  31. 1 point
    بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته أيها الأحبة منذ أن بدأت في تعلم الأكسس حيث كانت بداياتي في هذا المنتدى المبارك وكنت أتمنى طريقة شرح معينة حيث إن المبتدئ منا لا يحتاج للشيء النظري البحث إنما يحتاج لإنارة الطريق حتى يصل إلى المطلوب من خلال أمثلة مبسطة وذلك بحكم أن ليس كل مشارك في المنتدى متخصص في البرمجة ونحوها .. وكنت منذ أن بدأت أجمع الأمثلة ثم أقوم بفكها والنظر في الاكواد ونحوها وكان يشكل علي كثيرا معرفة اسم النموذج في الكود والسجل ونحوها وتمييزها عن بقية الكود فالكود أحيانا يكون به كلمات إنجليزية هي أساس في الكود فلا تتغير إنما الذي يتغير كلمات معينة كاسم النموذج أو السجل أو الاستعلام ونحوها ... وكم عانيت في ذلك وخاصة إذا كان المثال معقدا. ومن هذا أحببت أن نبدأ جميعًا في مشروع أظنه نافعا بإذن الله تعالى وما كان لي أن أطرحه دون إذن أساتذتي الفضلاء الذي لهم سبق فضل علي بعد فضل الله بارك الله في علمهم وعملهم ... وتكمن الفكرة في هذا الموضوع أن يتم تخصيص هذا الموضوع بموضع معين مثلا طرائق البحث في نموذج أكسس فكل منا يجتهد في طرح ما يعرفه من طرائق البحث في نماذج أكسس بشرط أن تشرح بشرح وافي بالمثال بحيث تكون مرجعا لمن أراد البحث في هذا الموضوع (طرق البحث في الأكسس) وعلى ذلك أستأذنكم في طرح مثال أُسرُّ من خلال برأيكم وملحوظاتكم حيث إني لم أقف في شبكة الإنترنت على من تولى مثل ذلك وأتمنى أن يكون لهذا المنتدى قصب السبق ... عنوان الموضوع طرائق البحث في الأكسس : الطريقة الأولى : البحث في النموذج بكتابة جز من الكلمة نفرض أن لدينا جدولا اسمه Book يهتم بأسماء الكتب ونرغب أن نبحث عن كتاب معين بمجرد كتابة جزء من اسمه فنعمل الآتي: 1)نصمم جدولا باسم Book بداخله أسماء كتب تحت سجل nameBook 2) نصمم نموذجا مبني على جدول Book بنماذج مستمرة وليكن اسم النموذج FormBook. 3) ندرج في أعلى النموذج (رأس النموذج ) مربع نص ونسميه فرضا Text1 وبالطبع التسمية من خلال الضغط على مربع التسمية بالزر الأيمن ثم خصائص ثم غير ذلك ثم في خانة الاسم نكتب الاسم المطلوب. 4) نقوم بعمل استعلام مبني على جدول Book وليكن اسمه Qry في الاستعلام نجد سجل NameBook نكتب في الحقل الفارغ الذي بجواره الكود التالي : nz([book].[namebook];"**") حيث إن Book اسم الجدول و NameBook اسم السجل الذي بداخل الجدول. 5) في الاستعلام في المعايير تحت حقل الذي تم عمله في الفقرة رقم (4) نضع الكود التالي Like "*" & [forms]![formbook]![text1] & "*" حيث FormBook هو اسم النموذج و Text1 اسم مربع النص الذي تم إدراجه في رأس النموذج. 6) نذهب إلى النموذج ونضع المؤشر على مربع النص text1 ثم الزر الأيمن ثم خصائص ثم حدث ثم بعد التحديث نضع الأمر التالي Me.Requery 7) نذهب إلى خصائص النموذج من خلال الضغط على أي مكان فارغ في النموذج ثم الزر الأيمن ثم خصائص ثم نختار بيانات ثم مصدر السجل ثم نختار منه اسم الاستعلام Qry بعد ذلك يكون النموذج جاهزا للبحث فيه عن أي كتاب ويمكن تكرار ذلك لأكثر من مربع نص بنفس الخطوات السابقة وبالمثال يتضح المقال. ((هذا نموذج إن كان مناسبا نستمر عليه ليكون مرجعا ثم ننتقل إلى موضوع آخر (ولا ولا ولا أستغني عن الرأي والمشووورة وهذا جهد المقل) ...) والله الموفق طرائق البحث.rar
  32. 1 point
    اخوانى الافاضل تعلمت من شيخنا الجليل / @ابوخليل ان المرتجعات ( ويلزم ان نحدد انها مرتجعات بيع ) تعتبر بمثابة مشتريات اى انها تضاف الى المشتريات وكانها شراء جديد ولذلك اعتقد انها تضاف الى المشتريات وليست المبيعات ، ممكن اكون مخطئ فلست بمتخصص بالمحاسبة وان مرتجعات الشراء تعتبر بمثابة مبيعات اى انها تطرح من المبيعات وكانها بيع جديد لذلك اعتقدت ان الموضوع يحتاج الى متخصصين محاسبة حتى تعم الفائدة
  33. 1 point
    تم الحل بعد محاولات وتجارب لكن حصل المقصود لكم الشكر يا سادة Sub copy_data() Dim S As Worksheet: Set S = Sheets("ALL") Dim Q As Worksheet: Set Q = Sheets("Shift Schedule") Dim O As Worksheet: Set O = Sheets("Overtime") Dim A As Worksheet: Set A = Sheets("Attendance") Dim Final_Q: Final_Q = Q.Cells(Rows.Count, 1).End(3).Row Dim Final_S: Final_S = S.Cells(Rows.Count, 1).End(3).Row Dim Final_O: Final_O = O.Cells(Rows.Count, 1).End(3).Row Dim Final_A: Final_A = A.Cells(Rows.Count, 1).End(3).Row Dim RQ As Range: Set RQ = Q.Range("A8:AG" & Final_Q) Dim Rs As Range: Set Rs = S.Range("A8:AG" & Final_S) Dim RO As Range: Set RO = O.Range("A8:AG" & Final_O) Dim RA As Range: Set RA = A.Range("A8:AG" & Final_A) Dim i%, XQ, xO%, XA%, xx% XQ = RQ.Rows.Count: xO = RO.Rows.Count: XA = RA.Rows.Count Rs.ClearContents i = 1: xx = 8 Do Until i > XQ S.Cells(xx, 1) = RQ.Cells(i, 1) S.Cells(xx, 3).Resize(, RQ.Columns.Count - 2).Value = _ RQ.Cells(i, 3).Resize(, RQ.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop i = 1: xx = 9 Do Until i > xO S.Cells(xx, 1) = RO.Cells(i, 1) S.Cells(xx, 3).Resize(, RO.Columns.Count - 2).Value = _ RO.Cells(i, 3).Resize(, RO.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop i = 1: xx = 10 Do Until i > XA S.Cells(xx, 1) = RA.Cells(i, 1) S.Cells(xx, 3).Resize(, RA.Columns.Count - 2).Value = _ RA.Cells(i, 3).Resize(, RA.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop End Sub
  34. 1 point
    السلام عليكم آسف إن كان كلامي بالمشاركة السابقة فهم علي أنه تعقيد - ماقصدت سوي توضيح بعض الأسس العلمية من الناحية المحاسبية لاستخلاص الربح أو الخسارة للنشاط بطريقة صحيحة تعبر فعلا عن نتيجة أعمال النشاط بما أن هذا مجال عملي كمحاسب أما عن كوني هاوي ومبتدأ بمجال البرمجة: فمن بداهيات ما تعلمنا من أساتذتا أننا نسخر البرمجة لتسهيل العمل بالقواعد الصحيحة وليس ابتكار قواعد جديدة تتوافق مع البرنامج -- وهذا يؤدي بدوره الي ما قال أخي حلبي وكذلك مما تعلمنا من اساتذتنا أننا نقدم النصح في حال وجد مايتطلب التعديل في طريقة العمل - فما أسهل أن أعالج لك مشكلة صغيرة ثم بعد حلها تجد لديك مشكلات أكبر منها تحتاج معها للعودة الي نقطة الصفر - أرجو ألا يحمل كلامي معنا آخر - فكل ما تقدم هو اعتذار عن الاطالة في المشاركة السابقة. أما عن استفسار أخي حلبي فهذا سيحتاج الي محاضرة أخري في الأسس المحاسبية 😁 وأعتقد ليس مكانها هنا حتي لا تطول الردود ويخرج الموضوع عن مساره وان سمح الوقت سأرسل لك ردا علي الخاص ان لم يكن لديك مانع. عودا الي سؤال أخي ibzmh2015 ان شاء الله سأطلع علي المرفق واوافيك بالنتائج .
  35. 1 point
    وعليكم السلام -تفضل New Microsoft Excel Worksheet.xlsx
  36. 1 point
    السلام عليكم ورحمة الله وبركاته وبعد ... عزيزي العضو السائل عن الشريط الموجود بالبرنامج الموضح صورته بالمشاركة الأولى ... الحل بسيط جدا هو أن يكون لديك نسخة من البرنامج من إصدار أوفيس إكس بس أو 2003 وتعمل عليها شريط القوائم المطلوب ومن ثم تقوم باستيراد كل الكائنات للقاعدة من البرنامج الذي تعمل عليه ومن ثم تحويله للعمل على أي إصدار أحدث ...ففي القاعدة المرفقة لاحظ القوائم ولا يوجد أي نماذج لأن هذه هي القاعدة الفارغة التي أحتفظ بها بإصدار قديم mdb أقوم بفتحها على الأوفيس إكس بي وأقوم باستيراد النموذج أو التقرير الذي أحتاج ربطه على شريط القوائم كما ترى في الصورة بمسمى محدد ثم أقوم بحفظ الملف ونسخه وتسميته بأي إسم آخر غير القاعدة التي أخصصها لعمل شريط القوائم ثم أقوم بفتح الملف الجديد بأي اصدار حديث و أقوم باستيراد كل محتويات الملف الأصلي للبرنامج ثم أقوم بحفظه بأي صيغة أحتاجها سواء مفتوحة أو مغلقة كما ترى في الصورة التالية ويمنني معاونة حضرنك في عمل شريط قوائم للبرنامج الخاص بك بشرط إرسال البرنامج في صيغة mdb وبيان بالشريط كما تتخيله وحاضرين سيتم تلبية طلبك ولو شئت ممكن المراسلة على الخاص لحفظ حقوق تصميمك و جزاكم الله خيرا
  37. 1 point
    وعليكم السلام ورحمه الله وبركاته اخى الفاضل اهلا ومرحبا بك معنا فى منتدى الاكسيس ارجو منك الا تغضب من كلامى اخى الفاضل ان المنتدى تعليمى وليس لانشاء برامج كامله للاعضاء اى تبدا بالتعلم وانشاء برنامجك وحين تتوقف فى نقطه معينه تسال واخوانك واساتذتنا لايقصرون جزاك الله خيرا على كل ما تقوم به من اجل مساعده اخوانك تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق
  38. 1 point
    اخي العزيز انا فتحت ملف جديد بالاكسس ونسخت ملفاتك فيه من جديد واستبدلت كود الوحدة النمطية فقط واشتغل البرنامج بصورة صحيحة اخي العزيز / عندما تقوم باي عمل جديد بالاكسس / ضع عندك نسخة احتياطية للاحتياط لاي طاريء. تحياتي
  39. 1 point
    السلام عليكم 🙂 واصبح البرنامج مستعد يأخذ اي عدد 🙂 وبواجهة جديدة : . . جعفر 1158.2.mdb.zip
  40. 1 point
    وعليكم السلام ورجمة الله وبركاته يوجد مثال رائع لاستاذنا ابوخليل ترقيم متقدم.rar يمكنك التحكم بعدد الاصفار بجوار الرقم من خلال السطر التالي Me!Receiptno = "R-" & Format(xNext, "0000") & "-" & prtyr تحياتي
  41. 1 point
    السلام عليكم في الكثير من الأحيان نحتاج إلى معرف مصدر اختصارات سطح المكتب أو إلى معرفة هل هذا البرنامج لديه اختصار على سطح المكتب أم لا؟ نستطيع استخراج مصدر اختصارات سطح المكتب و ملفها من خلال هذا الكود: Dim strFolder As String Dim strDesktop As String Dim typefiche As String Dim strtxt As String typefiche = "\*.lnk" strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") strFolder = Dir(strDesktop & typefiche, vbDirectory) Do While strFolder <> "" If Not (strFolder = "." Or strFolder = "..") Then strtxt = "Full Path: " & CreateObject("WScript.Shell").CreateShortcut(strDesktop & "\" & strFolder).TargetPath & vbCrLf strtxt = strtxt & "Path Folder: " & CreateObject("WScript.Shell").CreateShortcut(strDesktop & "\" & strFolder).WorkingDirectory & vbCrLf MsgBox strtxt End If strFolder = Dir() Loop مصدر اختصارات من سطح المكتب.rar
  42. 1 point
    بعض أسئلة الاستبيانات تكون ايجابية و الاخرى سلبية ، و فى حال رغبت فى اخذ متوسطات لاجابات محور معين يضم اسئلة سلبية و ايجابية ، يجب عكس النتائج الرقمية المناظرة لقيمة الرد، فمثلا الاصل فى حالة مقياس ليكارد الخماس أن تكون اجابة اتفق جدا = 5 و اتفق = 4 ، .... و هكذا ، فاذا كانت الاسئلة كلها ايجابية و هناك سؤال سلبي فهنا يجب تعديل القيم لاجابات هذا السؤال لتكون اتفق جدا = 1 ، اتفق = 2 ، ... قبل اجراء اية عمليات حسابية على المحور مثل حساب المتوسط مثلا. و اذا كان التفريغ يدويا فيمكن مراعاة ذلك ، اما فى حالة استخدام ادوات الكترونية لجمع الاستبيان فان الارقام تكون مسجلة بالفعل و يجب تعديلها ، و قد تكون العملية مرهقة فى حالة تعدد المتغيرات او كبر حجم العينة. و بالطبع يمكن تعديل الاسئلة لتكون فى نفس المحور ايجابية او سلبية ، و لكن فى بعض الاحيان يكون من الاسهل على مجيب الاستبيان الاجابة عن الصيغة الايجابية او السلبية بحسب المتعارف عليه في بعض مجالات التخصص ، فبصرف النظر عن صحة وجود اسئلة سلبية و ايجابية فى نفس المحور ، للقيام بعملية تعديل (عكس) نتائج عدد من الاجابات لتحويلها من ايجابية الي سلبية بصورة الية ، قمت باعداد دالة فى الاكسيل لتقوم بهذا الغرض (مرفق المثال). لنفرض ان الاجابات الاصلية كانت عن درجة الاتفاق مع كون وقت المشروع مناسب ، و اردتا تغيير الاجابات لتعبر عن كون زمن المشروع غير مناسب كما هو مبين: و ذلك عن طريق استخدام الدالة التالية: Function Reverse_Ordinal2(original_Ordinal As Byte) Dim newVal As Byte Select Case original_Ordinal Case Is = 1 newVal = 5 Case Is = 2 newVal = 4 Case Is = 3 newVal = 3 Case Is = 4 newVal = 2 Case Is = 5 newVal = 1 Case Else newVal = 0 End Select Reverse_Ordinal2 = newVal End Function مرفق المثال و لتشغيله يجب تفعيل الماكرو فى ملف الاكسيل و يتم ادراج الكود فى ملف اخر عن طريق فتح شاشة محرر البيزيك ALT+F11 ثم : السحب للملف الحديد او اختيار ادراج موديول جديد و نسخ الكود او استخدام الدالة و الملف المرفق مفتوح و اذا لم يكن لك خبرة بالتعامل مع الكود ، و لا ترغب فى ذلك ، يمكنك استخدام الملف المرفق مباشرة للتحويل و سحب أو نسخ الدالة للاسفل لتمتد لعدد الاسطر المطلوب ، مع مراعاة تفعيل الماكرو عند فتح الملف لتعمل الدالة ReverseOrdinalLekerd.xlsm
  43. 1 point
    الیکم ھذا الرابط لعل تستفيدون منه ... https://boundstatesoftware.com/blog/4-ways-to-get-your-ms-access-database-on-an-android-tablet-or-phone وهذه اثنان من برامج لكي يقدرون توصل الى قاعدة اكسس وفي رابط الاول تم اعطاكم مزايا و عيوب كل الطرق ... https://play.google.com/store/apps/details?id=com.kmsoft.access_db_viewer https://play.google.com/store/apps/details?id=com.microsoft.rdc.android
  44. 1 point
    السلام عليكم هذه تظهر دائما عند النسخ واللصق اذا كان فيه حروف عربية بين الاكواد وهذه هي على الصورة الصحيحة Call MsgBox("مطلوب قم بتحديده واختياره (BData.mdb) ملف البيانات", vbCritical) واسم قاعدة البيانات الظاهرة تخصني وعليك بتعديلها الى قاعدة الجداول عندك
  45. 1 point
    استدعاء بيانات بطريقه سريعه جدا للحبيب ياسر العربي خليفه العلامه عبد الله باقشير استدعاء بيانات بطريقه سريعه.rar
  46. 1 point
    تفضل أستاذ حمدي .. يا بختك بموضوعك هذا حل آخر بالكود مشابه لحل الأستاذ الكبير أبو تراب (مع إمكانية أن يكون المدى مطاطي أي غير ثابت Dynamic) Distinct Validation List Across Columns.rar
  47. 1 point
    حياكم الله أجمعين وأعتذر لانقطاعي والحمد لله ... مرفق المطلوب طريقة البحث في النموذج الفرعي.rar
  48. 1 point
    طريقة ثانية : البحث في النموذج الفرعي نفرض أن لدينا مكتبة في جدول باسم Book تحوي اسم الكتاب والمؤلف والناشر وتاريخ النشر ونرغب في عمل مربع بحث مشترك بحيث عند الكتابة فيه يبحث في أي خانة مباشرة سواء كان اسم الكتاب أو المؤلف أو الناشر ... فالعمل على النحو التالي : 1) ننشئ جدولا باسم Book ونضمنه الحقول المطلوبة من اسم الكتاب والمؤلف والناشر ... إلخ. 2)ننشئ نموذجا مرتبطًا بالجدول (نماذج مستمرة) ونسميه FoBook. 3) ننشئ نموذجا آخر من جديد ثم طريقة عرض التصميم . 4) في رأس النموذج نضع مربعي نص الأول نسميه Text1 والآخر text2 5) في مربع النص text1 من الخصائص حدث عند التغيير نضع الكود التالي Dim x x = Text1.Text text2 = x Me.FoBook.Requery حيث text1 اسم مربع النص الأول و text2 اسم مربع النص الثاني وFobook هو اسم النموذج الذي تم عمله كما في الفقرة 2. 6) من خصائص مربع النص text2 تنسيق مرئي (لا). 7) في خانة التفصيل من هذا النموذج ندرج نموذج فرعي ونختار استخدام نموذج موجود ثم نختار نموذج FoBook. 8) نغلق النموذج ونقوم بحفظه باسم FoormBook 9) نعود للنموذج FoBook (الذي تم عمله في الفقرة 2) ومن خصائص النموذج بيانات مصدر السجل ثم نضغط على النقاط الثلاث ثم يطلب هل تريد عمل استعلام ثم موافق يفتح لك استعلام أدرج فيه حقول الجدول كافة. 10) وفي هذا الاستعلام ضع الكود التالي تحت كل حقل تريد البحث فيه في خانة معيار مع ملاحظة تدرجة في كل مرة في أو كما في المثال ثم اغلق واحفظ عملك Like "*" & [Forms]![Foormbook]![Text2] & "*" 11) ارجع إلى النموذج FoormBook واكتب في مربع النص الظاهر أمامك وتجد آليه البحث قد عملت.. أ والله الموفق طريقة البحث في النموذج الفرعي.rar
  49. 1 point
    السلام عليكم و رحمة الله استخدم اخي النسخ اللصق الخاص كقيم
  50. 1 point
    نفس الشيء ضع فى المعيار الخاص بحقل التاريخ فى مصدر بيانات التقرير Between [Forms]![FormName]![DateFrom] And [Forms]![FormName]![DateTo] حيث DateFrom و DateTo هي أسماء مربعات النص التي تحوي التاريخ مرفق مثال أعتقد أنه للاخ ابن مسقط Date_from_to.rar


×
×
  • اضف...