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

جرب هذا الكود أخي @TQTHAMI 🙂 شغله مباشرة واختر المجلد المطلوب .. Sub SetFolderAttributesToHidden() Dim fso As Object Dim fldr As Object Dim folderPath As String Set fso = CreateObject("Scripting.FileSystemObject") Set fldr = Application.FileDialog(4) If fldr.Show = -1 Then folderPath = fldr.SelectedItems(1) End If If folderPath <> "" Then fso.GetFolder(folderPath).Attributes = fso.GetFolder(folderPath).Attributes + 2 MsgBox "Folder attributes set to hidden." Else MsgBox "No folder was selected." End If Set fldr = Nothing Set fso = Nothing End Sub

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير بالنسبه للمشكله لم اصل اليها ولم تصادفنى فماذا فعلت حتى ظهرت لك ؟ بالنسبه للثانيه نسيت نقل كود فتح التقرير بعدما غيرت اسم الزر Private Sub cmdPrint_Click() If Len(Me.f_Print & "") = 0 Then DoCmd.RunSQL "UPDATE TABLE2 SET TABLE2.[First printing date] = Date(), TABLE2.[number of print] = '1' " & _ "WHERE (((TABLE2.[School year])='" & Me.SS & "') AND ((TABLE2.ID2)=[Forms]![F-TABLE1]![ID]));" Else DoCmd.RunSQL "UPDATE TABLE2 SET TABLE2.[The date of the last print] = Date(), TABLE2.[number of print] = Val([number of print])+1 " & _ "WHERE (((TABLE2.[School year])='" & Me.SS & "') AND ((TABLE2.ID2)=[Forms]![F-TABLE1]![ID]));" End If DoCmd.OpenReport "Q-TABLE1", acViewPreview, , "[School year] ='" & Me.SS & "'" End Sub

وعليكم السلام ورحمه الله وبركاته اتفضل على قدر فهمى للسؤال اخى @AboBahaa ان شاء الله يكون ما تريد Private Sub cmdPrint_Click() If Len(Me.f_Print & "") = 0 Then DoCmd.RunSQL "UPDATE TABLE2 SET TABLE2.[First printing date] = Date(), TABLE2.[number of print] = '1' " & _ "WHERE (((TABLE2.[School year])='" & Me.SS & "') AND ((TABLE2.ID2)=[Forms]![F-TABLE1]![ID]));" Else DoCmd.RunSQL "UPDATE TABLE2 SET TABLE2.[The date of the last print] = Date(), TABLE2.[number of print] = Val([number of print])+1 " & _ "WHERE (((TABLE2.[School year])='" & Me.SS & "') AND ((TABLE2.ID2)=[Forms]![F-TABLE1]![ID]));" End If End Sub Database (naser)_1.accdb

وعليكم السلام ورحمة الله وبركاته 🙂 الأستاذ حمدي تم عمل المطلوب وتضبيط الكود حسب الطلب 🙂 انتبه إلى أني نقلت أمر الإرسال إلى الزر بدل أمر بعد التغيير للقائمة المنسدلة .. تجرية.mdb

الكود بعد التعديل: Private Sub m_AfterUpdate() Select Case Me.m Case "اليوم" Me.n1 = Date Me.n2 = Date Case "اسبوعي" If Weekday(Date, vbSunday) = vbSunday Then Me.n1 = Date Else Me.n1 = Date - Weekday(Date, vbSunday) + 1 End If Me.n2 = Me.n1 + 6 Case "الشهر الحالي" Me.n1 = DateSerial(Year(Date), Month(Date) + 0, 1) Me.n2 = DateSerial(Year(Date), Month(Date) + 1, 0) Case "الربع الأول" Me.n1 = DateSerial(Year(Date), 1, 1) Me.n2 = DateSerial(Year(Date), 3, 31) Case "نصف سنوي" Me.n1 = DateSerial(Year(Date), 1, 1) Me.n2 = DateSerial(Year(Date), 6, 30) Case "الربع الثالث" Me.n1 = DateSerial(Year(Date), 1, 1) Me.n2 = DateSerial(Year(Date), 9, 30) Case "سنوي" Me.n1 = DateSerial(Year(Date), 1, 1) Me.n2 = DateSerial(Year(Date), 12, 31) Case Else End Select End Sub PeriodRange_01.accdb

=IFERROR(VLOOKUP(@$A$2:$A$6,Sheet2!$A$1:$B$6,2,0),"")

Try this code (Add it to the userform module) Private Sub TextBox1_Change() Dim arrExtensions, x, ws As Worksheet, sImagePath As String, sFile As String, i As Long Set ws = ThisWorkbook.Sheets(1) arrExtensions = Array(".jpg", ".jpeg", ".png", ".gif", ".bmp") x = Application.Match(Val(TextBox1.Value), ws.Columns(1), 0) If IsError(x) Then Me.Image1.Picture = Nothing: Exit Sub sFile = ws.Range("A" & x).Value For i = 0 To UBound(arrExtensions) sImagePath = ThisWorkbook.Path & "\" & sFile & arrExtensions(i) If Dir(sImagePath) <> "" Then On Error Resume Next Me.Image1.Picture = LoadPicture(sImagePath) If Err.Number <> 0 Then MsgBox "Error Loading The Image: " & Err.Description On Error GoTo 0 Else Exit For End If End If Next i End Sub But you have to know the png extension is not supported by userform image control so this will raises Invalid Picture

اخي علي بن علي تفضل طباعة اعمدة محددة مع صفوف اعتمادا على قيمة نصية+111.xlsb.xlsm

السلام عليكم ورحمة الله وبركاته .. في ليلة صافية والجو بين البارد والمعتدل .. وأنا أتصفح الفيس بوك .. لمحت سؤال لأحد الإخوة يطلب فيه طريقة لحساب عدد أيام الغياب والحضور للموظفين في نموذج مستمر .. فخطرت على بالي هذه الدالة الصغنونه الظريفة .. فوضعتها موضع التنفيذ مع نموذج دايناميكي لتقويم شهري كنت قد صممته سابقا مع سبق الترصد 😁 وقلت أضعه بين أيدي جنابكم لمن أراد أن يستفيد منه .. ولمن أراد أن ينفعنا بنصائحه الثمينة والسمينة 😅🖐🏼️ وهذه هي الدالة المستخدمة في عمودي مجموع الحضور والغياب : Public Function Count_Present_Absent(P_or_A As String) As Integer ' دالة لحساب عدد أيام الحضور وعدد أيام الغياب من تقويم مكون من 31 يوم ' By: Moosak 'P_or_A = Present or Absent ? وتعني أنت تريد حساب الحضور أم الغياب ' على أفتراض أن أسماء حقول الأيام هي على التوالي : Day1, Day2, Day3 ...... Dim x As Integer Dim Frm As Form: Set Frm = Screen.ActiveForm Dim PresentDays As Integer, AbsentDays As Integer Count_Present_Absent = 0 For x = 1 To 31 If Frm.Controls("Day" & x).Value Like "*ح*" Then ' حساب عدد أيام الحضور PresentDays = PresentDays + 1 ElseIf Frm.Controls("Day" & x).Value Like "*غ*" Then ' حساب عدد أيام الغياب AbsentDays = AbsentDays + 1 End If Next ' الدالة ترجع مجموع عدد أيام الحضور أو مجموع عدد أيام الغياب حسب الطلب If P_or_A = "P" Then Count_Present_Absent = PresentDays ElseIf P_or_A = "A" Then Count_Present_Absent = AbsentDays Else Set Frm = Nothing Exit Function End If Set Frm = Nothing End Function موضوع سريع وعلى الطاير قبل أن تتفلت المعلومات 😊🖐🏼️ تسجيل حضور وغياب الموظفين.accdb

السلام عليكم و رحمة الله اخوتى و أحبتى اعضاء منتدى اوفيسنا الحقيقة ترددت كثيرا قبل كتابة هذا الموضوع و لعدة اسابيع و لكنى اليوم قررت ان ارتدى ثوب الشجاعة و اقدم اليكم ذلك البرنامج المتواضع و الذى كلفنى جهدا ليس بالقليل و قد اوحى الى فكرته حفيدى مازن لذا قررت ان اسمى البرنامج باسمه و فكرة البرنامج هو استعراض حروف و كلمات اللغة العربية البسيطة و التى تناسب عقلية تلميذ كى جى 1 و كى جى 2 مدعوما بالصور التى قد يعرفها الطفل فى ذلك العمر ملحوظة هامة : لابد من دعم الابوين حتى يتعلم الطفل استخدام البرنامج بنفسه و الآن على بركة الله .... اليكم البرنامج ( بعد فك الضغط لا يتم استخراج اى ملف من الفولدر) Mazen.rar

اخي معني هذا الخطأ #N/A .... يعني الاسم التي تبحث عنة غير موجود ... تم حل الخطأ ... اختار الاسم من القائمة المنسدلة تفضل Test.xlsx

أيوه اشتغلت عندى بتختار الملف بيختفى

عندي لم تنجح هل تم تجربته على اجهزتكم لان يمكن يكون مشكله عندي في الجهاز

أنا عدلت على الكود جرب مرة أخرى ، وهذا ما عندي عزيزي.

يسعد لي مساءك ابو احمد ياليت تكمل مشوارك في التعديل عليه

نظمت لك الكود بدون محرر الفيجوال جرب يمكن يشتغل معك. Private Sub cmd_Click() set objFSO As Object, objFolder As Object Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("C:\Users\tf1\OneDrive\Desktop\myfolder") If Me.cmd.Caption = "hide" Then Me.cmd.Caption = "show" If objFolder.Attributes = objFolder.Attributes And 2 Then objFolder.Attributes = objFolder.Attributes Xor 2 End If Else Me.cmd.Caption = "hide" If objFolder.Attributes = objFolder.Attributes Xor 2 Then objFolder.Attributes = objFolder.Attributes And 2 End If End If Set objFSO = Nothing Set objFolder = Nothing End Sub

اتفضل اخى Private Sub cmdPrint_Click() DoCmd.SetWarnings False If Len(Me.f_Print & "") = 0 Then DoCmd.RunSQL "UPDATE TABLE2 SET TABLE2.[First printing date] = Date(), TABLE2.[number of print] = '1' " & _ "WHERE (((TABLE2.[School year])='" & Me.SS & "') AND ((TABLE2.ID2)=[Forms]![F-TABLE1]![ID]));" Else DoCmd.RunSQL "UPDATE TABLE2 SET TABLE2.[The date of the last print] = Date(), TABLE2.[number of print] = Val(nz([number of print],0))+1 " & _ "WHERE (((TABLE2.[School year])='" & Me.SS & "') AND ((TABLE2.ID2)=[Forms]![F-TABLE1]![ID]));" End If DoCmd.SetWarnings True DoCmd.OpenReport "Q-TABLE1", acViewPreview, , "[School year] ='" & Me.SS & "'" End Sub Database (naser)_2.accdb

هذا الكود أنا وجدته قبل مشاركات الزملاء ليعمل من خلال الاكسل وأنا عدلت عليه ليعمل من خلال الأكسس ولكن بعد تجربتي له لم يعمل بشكل صحيح وتوقفت عن وضعه لكم.

شكرا لمرورك عزيزي ، كلامك صحيح إذا كان المطلوب تقرير ربعي/ربع سنوي ولكن عند تدقيق كود السائل يتضح أن المطلوب مختلف ، لاحظ أنه جعل البداية للكل 01/01 وكذلك للأسماء نصف سنوي بدلا من الربع الثاني وسنوي بدلا من الربع الرابع أو الأخير وكذلك أن السائل لم يطلب المساعدة إلا في نهاية الشهر الحالي ولم يشر إلى بقية المدد. أنا قلت أضرب عصفورين بحجر واحد فنظمت له الكود شكلا وأصلحت له نهاية "الشهر الحالي" وفترة "أسبوعي" وربما هو يريدها آخر سبعة أيام مع أن حسبتهم ثمانية أيام، فلننتظر مراجعته.

وهنا صولات وجولات حول هذا الموضوع 🙂

الموضوع بسيط أخي @النجاشي ليست بتلك الصعوبة 🙂 أساسا أنت وضعت الفكرة مسبقا ، باقي أنك تنشيء المربعات التي ذكرتها في الجدول ومن ثم تضيفها في النموذج ( بعد أن تحذف الغير مرغوب فيها طبعا .. ولا تنسى حذفها من الجدول أيضا ) .. فقط انتبه لحقل المجموع Total هو موجود في الاستعلام ومعتمد على أيام الشهر .. لذلي يحتاج تعديلها حسب المربعات الجديدة ..

شكرا لك أستاذنا القدير أبو أحمد 🙂 هذي الأكواد مهمة للحصول على الفترات المطلوبة في كثير من الأحيان .. لكن بالنسبة للأرباع مو الأفضل أنه يكون بداية كل ربع هو اليوم اللي يتلي الربع اللي قبله ؟ 🙂 يعني: الربع الثاني 1/4 الربع الثالث 1/7 الربع الرابع 1/10

وفيك بارك الله اخى كانورى واجرك ان شاء الله ، الله آمين ووالديك

أخي @النجاشي أنت غيرت الموضوع تماما 😅🖐🏼️ يحتاج إعادة تصميم الجدول والنموذج بطريقة مختلفة عن أصلها الحالي 😄 ربما يكون هذا حل المشكلة أخي أحمد 🙂 :

استاذي الغالي @Moosak فكره جميله ورائعه جزاك الله خير ياليت استاذي تنظر الي المرفق عدلت فيها المطلوب كي يكون صالح لتوزيع التركه حسب اسماء المواضع الذي بالجدول التركه توزيع الميراث .rar

وعليكم السلام ورحمة الله وبركاته 🙂 من غير تنزيل المرفق .. يمكنك أن تفعل ذلك من خلال دوال التحقق من وجود بيانات في جداول ( الولايات والبلديات ) كدالة DCount مثلا .. يتم الفحص عند فتح النموذج الرئيسي .. فإذا كان الرقم الذي تحضره الدالة أكبر من صفر يتم تفعيل القوائم الأخرى .. وإذا كانت صفر فإنها لا تعمل .. هذه هي الفكرة .. جرب تطبيقها بنفسك حتى تثري معلوماتك 🙂 وتوجد لدي طريقة أستخدمها في برامجي عندما يكون لدي شيء أريد التحقق منه دائما في أماكن متفرقة في البرنامج .. هو تحويل عملية التحقق إلى دالة عامة Public Function من نوع (True/False) .. وهذا يسهل علي معرفة النتيجة بمجرد استدعاء اسم الدالة .. بدل تكرار الكواد عدة مرات .. وهذا مثال عليها (التحقق من وجود سجلات في جدول الولايات مثلا ) : Public Function WelayatIsThere() As Boolean If DCount("*", "[Welayat_Tbl]") > 0 Then WelayatIsThere = True Else WelayatIsThere = False End If End Function وبهذا للتأكد من وجود سجلات في جدول الولايات فقط أكتب اسم الدالة هكذا : WelayatIsThere ومباشرة ستجيبك الدالة بنعم أو لا (True/False) 🙂 وهذا مثال لطريقة كتابة الكود باستخدام الدالة السابقة : Me.ListBtn.Enabled = WelayatIsThere وهذه الطريقة تغنيك عن كتابة العديد من الأسطر حيث أن الدالة ترجع أحد القيمتين (True/False) عليها سيتم تمكين القائمة أو لا .. 🙂

وهذه طريقة جعله يكتب من اليمين إلى اليسار لأستاذنا @jjafferr 🙂

نعم بالضبظ هو الموضوع ... انا اقول شفت موضوع في هذا الخصوص بارك الله فيك اخي واستاذي @ابوبسمله كتب الله اجرك ورحم الله والديك

Draw a button inside cell B9 or any other cell that will be visible all the time and assign the following macro to that button. The code is flexible and you can assign the desired columns to be shown and also to assign the rows you would like to hide Sub Test() Dim desiredColumns(), aRows(), e, ws As Worksheet, columnsHidden As Boolean, lastColumn As Long, i As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Sheets(1) With ws desiredColumns = Array(2, 3, 7, 9, 10, 13, 15, 20, 23) aRows = Array("1:8", "25:27") lastColumn = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column If Not columnsHidden Then .Columns(lastColumn + 1).Resize(, .Columns.Count - lastColumn).EntireColumn.Hidden = True For i = 1 To lastColumn If Not IsInArray(i, desiredColumns) Then .Columns(i).EntireColumn.Hidden = True End If Next i For Each e In aRows .Rows(e).EntireRow.Hidden = True Next e columnsHidden = True .PrintPreview .Activate GoTo iLine Else iLine: .Columns.EntireColumn.Hidden = False For Each e In aRows .Rows(e).EntireRow.Hidden = False Next e columnsHidden = False End If End With Application.ScreenUpdating = True End Sub Function IsInArray(ByVal valToBeFound, ByVal arr) As Boolean Dim ele For Each ele In arr If ele = valToBeFound Then IsInArray = True: Exit Function Next ele IsInArray = False End Function

اغلق الوجهة ثم قم بتمكين المحتوى من الشرط الاعلى

جرب الاتى Sub SaveBill() On Error Resume Next Dim Lrow As Integer Lrow = ورقة3.Cells(ورقة3.Rows.Count, "a").End(xlUp).Offset(1, 0).Row ورقة3.Cells(Lrow, "A") = sheet1.Cells(2, "B") ورقة3.Cells(Lrow, "B") = sheet1.Cells(3, "B") ورقة3.Cells(Lrow, "C") = sheet1.Cells(4, "B") ورقة3.Cells(Lrow, "D") = sheet1.Cells(29, "D") ورقة3.Cells(Lrow, "E") = sheet1.Cells(29, "F") ورقة3.Cells(Lrow, "F") = sheet1.Cells(30, "F") ورقة3.Cells(Lrow, "G") = sheet1.Cells(31, "F") ورقة3.Cells(Lrow, "H") = sheet1.Cells(32, "F") ورقة3.Cells(Lrow, "I") = sheet1.Cells(33, "F") Dim LastRow As Integer Dim R As Integer '''''''''''''''''''''''''''''''' For R = 7 To 27 If (sheet1.Cells(R, "b") <> "") Then LastRow = ورقة2.Cells(ورقة2.Rows.Count, "A").End(xlUp).Offset(1, 0).Row ورقة2.Cells(LastRow, "A") = sheet1.Cells(2, "B") ورقة2.Cells(LastRow, "B") = sheet1.Cells(3, "B") ورقة2.Cells(LastRow, "C") = sheet1.Cells(4, "B") ورقة2.Cells(LastRow, "D") = sheet1.Cells(R, "B") ورقة2.Cells(LastRow, "E") = sheet1.Cells(R, "C") ورقة2.Cells(LastRow, "F") = sheet1.Cells(R, "D") ورقة2.Cells(LastRow, "G") = sheet1.Cells(R, "E") ورقة2.Cells(LastRow, "H") = sheet1.Cells(R, "F") End If Next '''''''''''''''''''''''''''''''''''''''' sheet1.Range("b2").ClearContents sheet1.Range("b3").ClearContents sheet1.Range("b4").ClearContents sheet1.Range("b7:e27").ClearContents End Sub غيرت اسم الورقة من ورقه1 الى sheet1

السلام عليكم جرب الملف المرفق لاخفاء او اظهار المجلد مع التاكد من مسار المجلد تحياتي hide_show.accdb

هل هذا ماتبغاه SecretFolder.rar

تفضل أخي ولا تنسى الضغط على أفضل اجابة DD112.accdb

حياك الله أستاذ حاولت أن أسهل عليكم بقدر المستطاع بحيث أحتفظ بالبيانات الأصل ولكن أصبح بعض التعديل يتطلب مراجعة كلية لكل الأكواد وهذا متعب علي حاليا. قمت بالتعديل على البيانات التي تلصق في صفحة المسودة القسم الأيمن/الأول بما يعني أن البيانات الأصلية لن تكون متوفرة بعد المعالجة. مع ملاحظة أن الكود يقوم بتقريب كل الدرجات السعي والنهائية. نحتاج مشاهدة صورة أخرى من هذه النسخة شبيهة للصورة السابقة. توزيع القرار لمدارس العراق_05.xlsm

وعليكم السلام ورحمة الله وبركاتة ضع الفولدر المسمي تخزين علي برتيش D ....وان ارت تغير الموقع يكن من هنا ... FName = "d:\تخزين\" واستخدم الملف المسمي Main من اي مكان تفضل تخزين.rar

وعليكم السلام ورحمة الله وبركاتة تفضل طباعة اعمده محدده.xlsm

وجزاك خيرا ❤️❤️ واقرا الموضوع وان شاء الله تستفيد بيه شرح للمتغيرات

وعليكم السلام أخي أزهر 🙂 طلبط بسيط بإذن الله ، ولكن سأعرض عليك خدمات أكثر 😊 - هل تريد نقل الملف أيضا إلى مجلد بجانب قاعدة البيانات ؟ - وإضافة زر لفتح الملف .. ؟ - وزر آخر لحذفه ؟ إذا كانت إجابتك بنعم .. فسأرفق لك الأكواد .. أما إذا كنت فقط ستكتفي بالسؤال فهذا هو الكود الذي طلبته 🙂 : On Error GoTo ErrHandler Dim fd As Object Dim filedialogPath As String Set fd = Application.FileDialog(1) fd.AllowMultiSelect = False fd.Title = "حدد الملف المطلوب" fd.Filters.Clear fd.Filters.Add "كل الملفات", "*.*" If fd.Show = True Then 'Debug.Print fd.SelectedItems(1) Me.filesource = fd.SelectedItems(1) Else MsgBox "لم تقم باختيار أي ملف" Exit Sub End If ErrHandler: If Err.Number = 0 Then Exit Sub Else MsgBox "Error Number : " & Err.Number & " :::: " & Err.Description End If

يستخدم الكود أعلاه للإعلان عن متغيرين ، iRow و ws. تم التصريح عن المتغير iRow كنوع بيانات طويل ، وهو نوع بيانات عدد صحيح يمكنه الاحتفاظ بقيم من -2،147،483،648 إلى 2،147،483،647. يتم التصريح عن المتغير ws ككائن ورقة عمل ويتم تعيينه للإشارة إلى ورقة العمل المسماة "data"

بعد اذن معلمي واستاذي الاستاذ جعفر هل هذا طلبك ؟ DD111.accdb

وعليكم السلام 🙂 في النموذج ، في اعدادات حقل "الرقم العام" ، في الفيمة الافتراضية Default Value ، استخدم الكود التالي: =nz(DMax(cint([الرقم العام]),"Table_Name"),1) . طبعا يجب تغيير اسم الحقل والجدول ، والكود يعطي اكبر رقم ، بينما اذا عنك اكبر رقم لكل سنة ، او لكل مؤسسة ، فيجب استعمال المعيار في الكود اعلاه ، هكذا : =nz(DMax(cint([الرقم العام]),"Table_Name","[السنة]=" & 2022),1) جعفر

وعليكم السلام ورحمة الله وبركاته 🙂 انسخ هذي الدالة عندك في موديول جديد : Public Function ShowHideRibbon(ShowRibbon As Boolean) On Error GoTo ErrHandler '*********************( إخفاء/إظهار الشريط العلوي وجميع النوافذ )************************** If ShowRibbon = False Then '--------------------------------(إخفاء الريبون والنفجيشن بان) DoCmd.ShowToolbar "Ribbon", acToolbarNo ' Hide Navigation Pane: DoCmd.NavigateTo ("acnavigationcategoryobjecttype") DoCmd.RunCommand (acCmdWindowHide) '--------------------------------(جميع تضبيطات تقفيل القاعدة وإخفاء القوائم ومنع الزر الأيمن والاختصارات) Application.SetOption "Show Status Bar", False CurrentDb.Properties("ShowDocumentTabs") = False Application.SetOption "Auto compact", True Application.SetOption "Remove Personal Information", False Application.SetOption "Themed Form Controls", False Application.SetOption "DesignWithData", False CurrentDb.Properties("AllowDatasheetSchema") = False Application.SetOption "CheckTruncatedNumFields", False CurrentDb.Properties("AllowFullMenus") = False CurrentDb.Properties("AllowShortcutMenus") = False ElseIf ShowRibbon = True Then '--------------------------------(إضهار الريبون والنفجيشن بان) DoCmd.ShowToolbar "Ribbon", acToolbarYes 'Unhide the navigation pane On Error Resume Next Call DoCmd.SelectObject(acTable, , True) Call DoCmd.SelectObject(acMacro, , True) Call DoCmd.SelectObject(acForm, , True) On Error GoTo ErrHandler '--------------------------------(فتح خصائص قاعدة البيانات وإظهار القوائم وتفعيل الزر الأيمن والاختصارات) Application.SetOption "Show Status Bar", True CurrentDb.Properties("ShowDocumentTabs") = True Application.SetOption "Auto compact", True Application.SetOption "Remove Personal Information", True Application.SetOption "Themed Form Controls", True Application.SetOption "DesignWithData", True CurrentDb.Properties("AllowDatasheetSchema") = True Application.SetOption "CheckTruncatedNumFields", True CurrentDb.Properties("AllowFullMenus") = True CurrentDb.Properties("AllowShortcutMenus") = True End If '--------------------------------------------------------------------------- ErrHandler: If Err.Number <> 0 Then MsgBox Err.Number & " \\\\\ " & Err.Description, , "Function: ShowHideRibbon" Resume Next Else Exit Function End If End Function هذي الدالة تخفي لك الشريط العلوي والجداول وجميع العناصر وغيرها .. بعدين أعمل ماكرو جديد واحفظة باسم Autoexec ( ضروري التسمية تكون نفسها بالحرف ) افتح الماكرو واعمل فيه أمر RunCode ونادي الدالة هكذا : =ShowHideRibbon(False) وإذا بغيت تغير رايك وتظهر الشريط العلوي وبقية العناصر تغير ال False إلى True ثم تشغل الماكرول بالضغط على RUN وبعدها تعيد تشغيل البرنامج .. << المرفق >> https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=216275&key=be0665907152bc7f887f7580f9fc9983

جعله الله في ميزان حسناتك يوم القيامة

جعله الله في ميزان حسناتك