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

وعليكم السلام ورحمة الله اخي محمد عمل رائع ومتميز وغير مستغرب من استاذنا الفاضل @ابو جودي الذي تعلمنا ومازلنا نتعلم منه الكثير 🌹 بالنسبة للاخ شايب يفضل استخدام نظام صلاحيات محكم وبالتالي فلا حاجة لكلمة مرور لفتح نموذج او طباعة تقرير الامر الاخر ان وضع كلمة مرور بشكل مباشر في محرر الاكواد يتطلب الدخول لوضع التصميم عند الرغبة في تغييرها وهو مالا يمكن تحقيقه عند تحويل القاعدة الى ACCDE اضافة الى ان كتابة كلمة المرور في محرر الاكواد يجعل امكانية معرفتها اكثر سهولة حتى لو تم تحويل القاعدة الى ACCDE انظر هنا ⬇️ مداخلات اخونا الشايب تمثل رأي غير ملزم وليس الهدف منها انتقاد عمل الاخرين لذا نقول لمن يمر خذ او اترك

عندي هذا النموذج الرائع منذ سنوات واستخدمه في كل برامجي هو للامانة ليس من تصميمي اتوقع صممه الأخ الحبيب @ابو جودي اقدمه لكم هديه فهناك من يحتاجه بحث حسب تاريخ.accdb

السلام عليكم ورحمة الله تعالى وبركاته وانا فايت لاقيت استاذنا الجليل اخوانا @شايب قلت فى نفسى لا لابد من المرور والقاء السلام ومشاركة مع احبائى فى الله اليكم فكرة بدون دوال وهى الاحب الى قلبى الشرح 1- انشاء وحدة نمطية عامة وظيفتها الاعلان عن متغيرات عامة وهى كالاتى Public strPasswordPrompt As String Public boolPasswordPrompt As Boolean 2- ننشئ نموذج لكلمة السر على ان يكون اسمه frmPasswordPrompt وبه مربع النص لكتابة كلمة السر على ان يكون اسمه txtPassword زر امر التأكيد على ان يكون اسمه btnConfirmation ونضع الكود الاتى لزر الامر boolPasswordPrompt = True strPasswordPrompt = Nz(Me.txtPassword.Value) DoCmd.Close acForm, Me.Name وهنا نطلب منه انه يلحق القيمة True الى المتغير العام boolPasswordPrompt وان يلحق القيمة التى سوف يتم كتابتها فى مربع النص txtPassword الى المتغير العام strPasswordPrompt ثم يغلق النموذج زر امر الالغاء على ان يكون اسمه btnCancel ونضع الكود الاتى لزر الامر boolPasswordPrompt = False DoCmd.Close acForm, Me.Name وهنا نطلب منه انه يلحق القيمة False الى المتغير العام boolPasswordPrompt ثم يغلق النموذج الان يمكن استخدام كلمة سر فى اى مكان فى النموذج اما للحذف او للطباعة او لفتح نموذج حسب رغبة المصمم والان الية استدعاء هذا النموذج للعمل على زر الامر المراد قتح النموذج السرى من خلاله نضع الاكواد الاتية Const CORRECT_PASSWORD As String = "123" Const MSG_ENTER_PASSWORD As String = "Please enter a password to proceed." Const MSG_INCORRECT_PASSWORD As String = "Incorrect password. Operation canceled." Const MSG_PROCEED_SUCCESSFULLY As String = "proceed successfully!" Const MSG_OPERATION_CANCELED As String = "Operation canceled" Do DoCmd.OpenForm "frmPasswordPrompt", , , , , acDialog Select Case True Case boolPasswordPrompt Select Case True Case Nz(strPasswordPrompt, "") = "" MsgBox MSG_ENTER_PASSWORD, vbExclamation Case strPasswordPrompt <> CORRECT_PASSWORD MsgBox MSG_INCORRECT_PASSWORD, vbExclamation Case Else MsgBox MSG_PROCEED_SUCCESSFULLY DoCmd.OpenForm ChrW("1587") & ChrW("1585") & ChrW("1610") Exit Do End Select Case Else MsgBox MSG_OPERATION_CANCELED, vbExclamation Exit Do End Select Loop هذا شرح مبسط للفكرة العامة ولكن ان اردنا العمل اكثر احترافية ومرونة من خلال الاكواد فى وحدة نمطية انظر المرفق الاتى رقم سري.accdb

مشاركةً مع اساتذتي تفضل استاذ @salah.sarea محاولتي . 1- ضغط واصلاح القاعدة الخلفية للقاعدة الحالية (القاعدة الخلفية محمية بكلمة مرور) . 2- ضغط واصلاح اي قاعدة تختارها (القاعدة محمية بكلمة مرور) . 3- ضغط واصلاح اي قاعدة تختارها (القاعدة غير محمية ) . ووافني بالرد . compact and repair.rar

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

بناءا على طلب احد الاخوة مرفق قاعدة البيانات الرقم السري 12345 اتمنى من الاحبة الخبراء اثراء الموضوع بطرق اخرى اكثر احترافية رقم سري.accdb

للاسف غير مفهوم بالنسبة لي مادا تقصد بتنسيق الاسبوع يوم/شهر/سنة اما ادا كنت تقصد التواريخ عدل هدا الجزء من الكود a = Array("فواتير الأسبوع من", " ", CDate(desWS.[CV330]), " ", "إلى", " ", CDate(desWS.[DC330])) Set xDate = srcWS.Cells(2, lCol + 3).Offset(1).Resize(, 7) With xDate .Value = a: .Interior.Color = RGB(255, 255, 0) .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, Color:=RGB(0, 0, 0) If Not IsDate(xDate.Value) Then xDate.NumberFormat = "yyyy/mm/dd" ' قم بتعديل تنسيق التاريخ بما يناسبك End With Book معدل 3.xls

السلام عليكم اخونا الكبير شايب يعتقد ان طريقة جعفر للعمل على النواتين طريقة شاملة ولكن في مثل هذه الحالة التي واجهت الاستاذ سلوم بعد اضافة Ptrsafe فقط يكفي ان نقوم بتغير اي متغير رقمي من long الى LongLong او الى LongPtr وسوف يعمل البرنامج ويختصر عدة اسطر من الكود اخير LongPtr ليس نوع بيانات حقيقي وانما يتوافق مع الاصدرين 32 و 64 بحيث يتحول الى long مع 32 و longlong مع 64 ايضاح اخير يمكن تقيد فتح النموذج الاخير بحيث لا يمكن فتحه الا من خلال زر الامر بعد كتابة الرمز الصحيح ولكن نكتفي بهذه المشاركة اخونا الشايب رقم سري.accdb

اختلط علي الأمر هههههههه بسيطة دي يا دكتور .. احنا نحجز متغير من نوع Date وليكن اسمه التاريخ السابق ( PreviousDate ) ، ونحدد قيمته بناقص يوم للتاريخ الذي في مربع النص Text15 ، ثم نحدد قيمة مربع النص Text17 بتغيير بسيط ، ليصبح الكود كالآتي :- Dim PreviousDate As Date PreviousDate = DateAdd("d", -1, Me.Text15.Value) Me.Text17.Value = Nz(DLookup("rased", "T1", "mastedate = #" & Format(PreviousDate, "mm/dd/yyyy") & "#"), 0)

لما شرحته في طلبك ، ارفق ملف ليتم العمل عليه 😊

Try Sub Test() Dim ws As Worksheet, m As Long, i As Long, ii As Long Application.ScreenUpdating = False Set ws = ActiveSheet: m = 2 With ws .Columns("K:M").Clear .Columns("M").ColumnWidth = 11 With .Range("K1").Resize(, 3) .Value = Array("Group", "Number", "Work Date") .Interior.Color = RGB(146, 205, 220) .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter End With For i = 2 To 6 If .Cells(i, 2).Value < .Cells(i, 3).Value And IsNumeric(.Cells(i, 2).Value) And IsNumeric(.Cells(i, 2).Value) Then For ii = .Cells(i, 2).Value To .Cells(i, 3).Value .Cells(m, "K").Resize(, 3).Value = Array(.Cells(i, 1).Value, ii, .Cells(i, 4).Value) m = m + 1 Next ii End If Next i End With Application.ScreenUpdating = True End Sub

تم تعديل الكود والتأكد منه وتجربته . انسخه إلى مديول جديد ، واستدعيه بالأمر : ( CopactMyDb ) فقط حدد اسم قاعدة البيانات الخلفية التي بجانب القاعدة الرئيسية . Public Function compactDb(ByVal mydb As String, ByVal mydbb As String, ByVal mypass As String, Optional openIt As Boolean = False) Dim f As Integer Dim filenoext As String, extension As String, Access As String Access = """" & SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE""" filenoext = Left(mydb, InStrRev(mydb, ".")) extension = Right(mydb, Len(mydb) - InStrRev(mydb, ".")) f = FreeFile Open CurrentProject.Path & "\compact.bat" For Output As f Print #f, "CHCP 1256" Print #f, ":checkldb1" Print #f, "if exist """ & filenoext & "l" & extension & """ goto checkldb1" Print #f, Access & " """ & mydbb & """" & mypass & " /compact" If openIt Then Print #f, ":checkldb2" Print #f, "if exist """ & filenoext & "l" & extension & """ goto checkldb2" Print #f, Access & " """ & mydb & """" Else Print #f, "del ""%~f0""" End If Close f End Function Public Function CopactMyDb() On Error Resume Next Dim Mypath, CurrDB, BEndTBL As String BEndTBL = "B-TBL.accdb" 'اسم قاعدة البيانات الخلفية CurrDB = CurrentProject.Path & "\" & CurrentProject.Name Mypath = CurrentProject.Path & "\" & BEndTBL Call compactDb(CurrDB, Mypath, "", True) Shell """" & Left(Mypath, InStrRev(Mypath, "\")) & "\compact.bat""", 0 DoCmd.Quit acQuitSaveAll End Function Desktop.zip

طيب ، سأشرح لك الدالة `GenerateSequence` هذه الدالة تقوم بإنشاء تسلسل رقمي للاسماء المتشابهة في استعلام : 1. `Function GenerateSequence( FullName As String) As Integer`: هذا تعريف الدالة `GenerateSequence` التي تأخذ مُدخل واحد يُسمى ` FullName` من نوع `String` وتُرجع قيمة من نوع `Integer`. 2. `Static dict As Object`: هنا نُعرف متغير `dict` ككائن `Object`. الكلمة `Static` تعني أن الكائن `dict` سيحتفظ بقيمته حتى بعد انتهاء تنفيذ الدالة، وهذا مهم لأننا نريد أن يحتفظ القاموس بالاسماءوالأرقام المتسلسلة التي تم إضافتها سابقًا. 3. `If dict Is Nothing Then Set dict = CreateObject("Scripting.Dictionary")`: هذا الشرط يتحقق إذا كان الكائن `dict` لم يتم إنشاؤه بعد، وفي هذه الحالة يتم إنشاء كائن جديد من نوع "Dictionary" (قاموس). 4. `If Not dict.exists( FullName) Then`: هذا الشرط يتحقق إذا كان الاسم` FullName` غير موجود في القاموس `dict`. 5. `dict.Add FullName, dict.Count + 1`: إذا كان الاسم` FullName` غير موجود، يتم إضافته إلى القاموس مع قيمة تسلسل رقمي جديدة تُحسب بإضافة واحد إلى عدد الاسماء الموجودة في القاموس. 6. `GenerateSequence = dict( FullName)`: في النهاية، تُرجع الدالة القيمة المتسلسلة للاسم` FullName` الموجود في القاموس. باستخدام هذه الدالة في استعلام، يمكنك إنشاء حقل محسوب يعرض رقمًا متسلسلًا لكل اسم متشابه بناءً على ترتيب ظهوره في الاستعلام. هذا مفيد لتتبع الاسماء وترتيبها بشكل فريد داخل الاستعلام.

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

بكل سرور اخي @Alaa Ammar New يسعدنا اننا استطعنا مساعدتك

تقصد ان هدا الشكل لا يناسبك هل قمت بتجربة هدا Sub test() Dim lCol As Long, MyRng As Range Set desWS = ActiveSheet: Set ws = Sheet2 If Len(desWS.[CA328].Value) = 0 Then Exit Sub ws.Cells.Clear For i = desWS.[CA328] To desWS.[CE328]: desWS.[BU331].Value = i Set MyRng = desWS.[BW330:CK372] Application.ScreenUpdating = False MyRng.Copy If ws.[D9] = "" Then MyRng.Copy With ws.[c5] .PasteSpecial xlPasteValues: .PasteSpecial xlPasteFormats End With Else lCol = ws.Cells(9, ws.Columns.Count).End(xlToLeft).Column + 5 MyRng.Copy With ws.Cells(5, lCol) .PasteSpecial xlPasteValues: .PasteSpecial xlPasteFormats End With End If Application.CutCopyMode = False Application.ScreenUpdating = True Next i End Sub 2024-04-11 الفواتير من 2024-04-05 الى.pdf

تفضل اخى الكود بطريقه ثانيه لعلها تكون المطلوبه Private Sub TextBox2_Change() Application.OnTime Now() + TimeValue("00:00:02"), "ورقة1.test" End Sub Sub test() If TextBox2 = "" Then AutoFilterMode = False Else Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text Dim X X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0) If Not IsError(X) Then With ورقة3.Cells(X, "B") .Value = ورقة1.Cells(1, "I").Value .Interior.ColorIndex = 30 .Font.ColorIndex = 20 End With End If End If End Sub

ماعندك الا العافية استاذ فادي

اشكرك فووكش والحمدالله على سلامتك 🌹🌹

تفصل اخی If Forms!separet!Check71 = "-1" Then DoCmd.OpenReport "SeparetrBySelection", acViewPreview, "", "", acNormal DoCmd.PrintOut Else DoCmd.OpenReport "separetr", acViewPreview, "", "", acNormal DoCmd.PrintOut End If

بارك الله فيك وجزاك الله خيرا

تفضل أخي @Bshar ، تم الإستعانة بنموذج مؤقت Temp ، لإدراج قيم الفلترة فيه ومن ثم انشاء تقرير مبني على هذا الجدول . وهذا الكود ليقوم بتنفيذ المهمة :- Private Sub Rep_Btn_Click() ApplyFilter DoCmd.SetWarnings False DoCmd.RunSQL "DELETE FROM Temp" DoCmd.SetWarnings True Dim rs As DAO.Recordset Set rs = Me.tape5.Form.RecordsetClone If IsNull(Foksh) Then DoCmd.CancelEvent Exit Sub Else rs.MoveFirst Do Until rs.EOF Dim selectedValues() As String selectedValues = Split(Me.Foksh, ",") Dim i As Integer For i = LBound(selectedValues) To UBound(selectedValues) If InStr(1, rs!color, Trim(selectedValues(i)), vbTextCompare) > 0 Then CurrentDb.Execute "INSERT INTO Temp (ID, namee, [code-work], [t-namber], type, lincec, color) " & _ "VALUES (" & rs!ID & ", '" & Forms![add-tab]![xxf] & "', " & rs![code-work] & ", '" & rs![t-namber] & "', " & _ "'" & rs![type] & "', '" & rs![lincec] & "', '" & rs![color] & "')" Exit For End If Next i rs.MoveNext Loop rs.Close Set rs = Nothing DoCmd.OpenReport "Table1", acViewPreview End If End Sub Foksh.accdb وأعتذر عن التأخير بسبب ظرف صحي .

تفضل اخى ويرجى تعديل اسم الظهور الخاص بك الى اللغه العربية من لوحة التحكم بالضغط على اسمك اعلي يسار المنتدى وفق قواعد المشاركة office.xlsm

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

ضع كلمة المرور بين علامتي التنصيص ، جرب وبانتظار ردك 🤗

الف شكر يا استاذنا نفعنا الله بك وزادك من علمه

السلام عليكم عملية عد عدد المشاركات ، هي عملية مجدولة تتم كل فترة ولا تنعكس فى نفس وقت الرد ، و عليه فمن الطبيعي حدوث تأخير

جزاك الله خير اخي الكريم Foksh بيض الله وجهك .. فيه ملاحظة بسيطة وهي اذا كانت القاعدة لها كلمة مرور فكيف يكون العمل علما ان طريقتك يتم فيها الضغط والاصلاح لكن يطلب منك كلمة المرور والذي اريده ان لا يطلب مني كلمة المرور على كل عملية ضغط واصلاح بل تتم المعالجة اوتوماتيكي بدون الرجوع الي ... جزاك الله خير وتحملنا شوي 🤗

الملف بصيغة ACCDE ولا يمكن التعديل عليه يا صديقي

السلام عليكم 🙂 اذا عندنا تقرير بهذه الطريقة: . اليس الافضل دمج بيانات الحقل المتكررة عموديا في حقل واحد ، مثل الوورد مثلا الى : . طريقة العمل : 1. اعمل تقريرك بالطريقة اللي تراها مناسبة ، بالفرز والتصفية : . او بالمجاميع : . 2. ولكن قم بوضع جميع الحقول في قسم "التفصيل" Detail : . 3. ثم اجعل برواز جميع حقول هذا القسم شفافة . 4. ثم الحقول التي تريد دمجها ، اخفاء المتكرر = نعم ، Hide Duplicates = Yes . 5. ثم ضع هذه الاحداث للتقرير Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer) 'Border color not set, use field ForeColor Call Detail_Print_Run_All(5, "'اليوم', 'التاريخ','الزمن'") End Sub Private Sub Report_Open(Cancel As Integer) Call Report_Open_Run(Me.Name) End Sub Private Sub Report_Close() On Error Resume Next Set ctl_ReSize = Nothing End Sub Private Sub Report_Page() Call Report_Page_Run End Sub . 6. لا تحتاج الى عمل اي تغيير في الاحداث اعلاه ، فقط انسخها من هنا والصقها في تقريرك ، ما عدا اول جزء : عرض البرواز ، حيث نخبره باسماء الحقل/الحقول التي نريد دمجها عموديا ، لون البرواز يكون حسب اللون الذي نكتبه ، او اذا لم نكتب لون البرواز ، فلون البرواز سيكون لون نص الكلمات في الحقل . 7. نسخ الوحدة النمطية mod_Report_Field_Hieght_ReSize الى تقريرك ن وكذلك بدون عمل اي تغيير فيها : Option Compare Database Option Explicit Dim rpt_Name_ReSize As String Dim rgb_Border_ReSize As Long, ini_rgb_Border_ReSize As Long Dim Detail_Calc_Height_ReSize As Long Dim Exclude_fld_Name_ReSize As String Dim Add_H_Each_Record_ReSize As Boolean Dim fildMaxHeight_ReSize As Long Dim myDrawWidth As Integer Public ctl_ReSize As Control Dim i_ReSize As Integer, j_ReSize As Integer Dim x_ReSize() As String, tmp_ReSize As String Dim Count_Pages_ReSize As Integer Dim sfld_Name_ReSize() As String, sfld_Value_ReSize() As String, _ sfld_Count_ReSize() As Integer Dim L_ReSize As Single, T_ReSize As Single, W_ReSize As Single, H_ReSize As Single ' Function Detail_Print_Run_All(LineWidth As Integer, myFields As String, Optional border_Color As Long = 1) 'we can this Function in the following ways, indicating Border Color 'Call Detail_Print_Run_All(5, "'c1', 'save', 'b1'", RGB(0, 0, 0)) 'Border color is RGB Value 'Call Detail_Print_Run_All(5, "'c1', 'save', 'b1'", vbBlack) 'Border color is Black 'Call Detail_Print_Run_All(5,"'c1', 'save', 'b1'", vbMagenta) 'Border color is Magenta 'Call Detail_Print_Run_All(5,"'c1', 'save', 'b1'") 'Border color not set, use field ForeColor 'Call Detail_Print_Run_All(5,"'b1'", RGB(0, 0, 0)) '5 is Line Width 'we get most the Lines drawn in Detail Section, 'except for the Last Record in each page, where we use Report Page event (the last page is easy) ini_rgb_Border_ReSize = border_Color rgb_Border_ReSize = ini_rgb_Border_ReSize Exclude_fld_Name_ReSize = myFields Add_H_Each_Record_ReSize = False myDrawWidth = LineWidth 'make an array of the fields x_ReSize = Split(Exclude_fld_Name_ReSize, ",") ReDim Preserve sfld_Name_ReSize(UBound(x_ReSize)) ReDim Preserve sfld_Value_ReSize(UBound(x_ReSize)) ReDim Preserve sfld_Count_ReSize(UBound(x_ReSize)) '1 'do the Detail Lines for the remaining fields Call Detail_Sec_Max_Height '2 'now work on the special fields Lines For i_ReSize = 0 To UBound(x_ReSize) 'remove the ' , and the extra spaces from the Left and Right tmp_ReSize = RTrim(LTrim(Replace(x_ReSize(i_ReSize), "'", ""))) sfld_Name_ReSize(i_ReSize) = tmp_ReSize Call Scale_Box_Lines(tmp_ReSize) Next i_ReSize End Function Function Report_Open_Run(rpt_Name_ReSize_1) rpt_Name_ReSize = rpt_Name_ReSize_1 'Reset the variables from here Count_Pages_ReSize = 0 Erase sfld_Name_ReSize Erase sfld_Value_ReSize Erase sfld_Count_ReSize Detail_Calc_Height_ReSize = 0 End Function Function Report_Page_Run() 'make an array of the fields x_ReSize = Split(Exclude_fld_Name_ReSize, ",") 'now work on the special fields Lines For j_ReSize = 0 To UBound(x_ReSize) 'remove the ' , and the extra spaces from the Left and Right tmp_ReSize = RTrim(LTrim(Replace(x_ReSize(j_ReSize), "'", ""))) sfld_Name_ReSize(j_ReSize) = tmp_ReSize Set ctl_ReSize = Reports(rpt_Name_ReSize)(tmp_ReSize) If ini_rgb_Border_ReSize = 1 Then rgb_Border_ReSize = ctl_ReSize.ForeColor End If 'make it simple to understand L_ReSize = ctl_ReSize.Left W_ReSize = ctl_ReSize.Width T_ReSize = ctl_ReSize.Top 'H_ReSize = ctl_ReSize.Height 'we have to add the Sections/Fields ABOVE the Detail Section If Reports(rpt_Name_ReSize).Page = 1 Then H_ReSize = Detail_Calc_Height_ReSize + _ Reports(rpt_Name_ReSize).PageHeaderSection.Height + _ Reports(rpt_Name_ReSize).ReportHeader.Height Else H_ReSize = Detail_Calc_Height_ReSize + _ Reports(rpt_Name_ReSize).PageHeaderSection.Height End If Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize + H_ReSize)-(L_ReSize + W_ReSize, T_ReSize + H_ReSize), rgb_Border_ReSize 'Bottom Line Next j_ReSize Detail_Calc_Height_ReSize = 0 End Function Public Function Scale_Box_Lines(fld_Name As String) Set ctl_ReSize = Reports(rpt_Name_ReSize)(fld_Name) 'make it simple to understand L_ReSize = ctl_ReSize.Left W_ReSize = ctl_ReSize.Width T_ReSize = ctl_ReSize.Top H_ReSize = ctl_ReSize.Height If ini_rgb_Border_ReSize = 1 Then rgb_Border_ReSize = ctl_ReSize.ForeColor End If 'take the highst Height If fildMaxHeight_ReSize > H_ReSize Then H_ReSize = fildMaxHeight_ReSize End If If ctl_ReSize.Text <> sfld_Value_ReSize(i_ReSize) Then sfld_Value_ReSize(i_ReSize) = ctl_ReSize.Text sfld_Count_ReSize(i_ReSize) = 1 End If 'Box the cells 'Left and Right ctl_ReSize.BorderColor = vbWhite Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize, H_ReSize), rgb_Border_ReSize 'Left Line Reports(rpt_Name_ReSize).Line (L_ReSize + W_ReSize, T_ReSize)-(L_ReSize + W_ReSize, H_ReSize), rgb_Border_ReSize 'Right Line 'Top and Bottom If Reports(rpt_Name_ReSize).Page <> Count_Pages_ReSize Then 'first Count_Pages_ReSize = Count_Pages_ReSize + 1 Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize + W_ReSize, T_ReSize), rgb_Border_ReSize 'Top Line ElseIf sfld_Count_ReSize(i_ReSize) = 1 Then 'First Record Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize + W_ReSize, T_ReSize), rgb_Border_ReSize 'Top Line End If sfld_Count_ReSize(i_ReSize) = sfld_Count_ReSize(i_ReSize) + 1 End Function Public Function Detail_Sec_Max_Height() fildMaxHeight_ReSize = 0 'get the max Height For Each ctl_ReSize In Reports(rpt_Name_ReSize).Section(0).Controls If ctl_ReSize.Height > fildMaxHeight_ReSize Then fildMaxHeight_ReSize = ctl_ReSize.Height End If Next 'Draw lines around the fields For Each ctl_ReSize In Reports(rpt_Name_ReSize).Section(0).Controls If InStr(Exclude_fld_Name_ReSize, "'" & ctl_ReSize.Name & "'") = 0 Then Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth Reports(rpt_Name_ReSize).Line (ctl_ReSize.Left, ctl_ReSize.Top)-Step(ctl_ReSize.Width, fildMaxHeight_ReSize), ctl_ReSize.ForeColor, B 'just add the Heighs of ONE Record If Add_H_Each_Record_ReSize = False Then Detail_Calc_Height_ReSize = Detail_Calc_Height_ReSize + fildMaxHeight_ReSize Add_H_Each_Record_ReSize = True End If End If Next End Function . 8. ما عدا هذا الجزء ، والذي يجب ان نضع فيه اسماء جميع الاقسام التي فوق "قسم التفصيل" ، والتي بها ارتفاع : . من هنا نعرف اسم هذه الاقسام : . وهذه نتائج بعض التقارير التي تم النجربة عليها : . . . . ولم اتوصل لطريقة لجعل الكلمات في منتصف الحقل عموديا ، هكذا: جعفر Report_BoxLine_07.accdb.zip

السلام عليكم ورحمة الله وبركاته يوجد في المرفق جدولين موظفين وجدول للمواد يتم ادخال المواد للموظفين سنويا ليس كل المواد كل موظف يستحق مواد معينة اريد عمل استعلام يبين من هم اللذين لم يستلمو مادة مكتب في سنة 2022 يوجد استعلام بالمرفق لكن يظهر اللذين استلمو مادة مكتب كل الاحترام تجريبي.rar

تابع هذا الموضوع سيفيدك إن شاء الله 🙂

طيب تفضل <<<<<<<<>>>>>>>> تقرير اجازات.accdb

بسم الله الرحمن الرحيم ( ولا تنسوا الفضل بينكم ) هذا واجب علي تجاهكم أخي الأستاذ / حسونة 🌹

وجزاكم مثله ابو مالك على سرعه الاستجابه😍

هل تريدها بهذا الشكل ؟؟؟

اشكرك اخي على رحابة صدرك ... ولكن هل ينبغي أن نضع مسار ملف الجداول المرتبطة حتى يعمل الكود بصراحة حاولت ولكن يقوم بأغلاق قاعدة البيانات وفتحها دون أي تغيير ... واكتشف انها تقوم باصلاح قاعدة البيانات المفتوحة فقط ولا تصليح ملف الجداول المرتبطة... ان احاول تصفير الترقيم التلقائي في احدى الجداول لأنه يسبب لي بعض المشاكل عندما يصل الترقيم إلى رقم كبير مع الشكر

جزاكم الله خيرا

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

أعتذر عن التأخير والمتابعة بسبب ظرف صحي . أخي @salah.sarea و الأخ @kamelnet5 على العموم يا صديقي بعد التركيز في مشاركتي السابقة يبدو أنني قد توجهت بشكل خاطئ للمطلوب . القاعدة المقسمة والمرتبطة بقاعدة بيانات الواجهة الرئيسية ( الأمامية ) لا بد من أنها ترتبط مع الجداول دون أن تقوم بإدخال الباسوورد بشكل يدوي كل مرة هل هذا صحيح ؟؟ وعليه وإن كان / أو لم يكن هناك كلمة مرور لقاعدة بيانات الجداول جرب هذا المرفق يعمل معي بكفاءة . وهذا كود الدالة :- Public Function compactDb(ByVal mydb As String, ByVal mypass As String, Optional openIt As Boolean = False) Dim f As Integer Dim filenoext As String, extension As String, Access As String Access = """" & SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE""" filenoext = Left(mydb, InStrRev(mydb, ".")) extension = Right(mydb, Len(mydb) - InStrRev(mydb, ".")) f = FreeFile Open CurrentProject.Path & "\compact.bat" For Output As f Print #f, "CHCP 1256" Print #f, ":checkldb1" Print #f, "if exist """ & filenoext & "l" & extension & """ goto checkldb1" Print #f, Access & " """ & mydb & """" & mypass & " /compact" If openIt Then Print #f, ":checkldb2" Print #f, "if exist """ & filenoext & "l" & extension & """ goto checkldb2" Print #f, Access & " """ & mydb & """" Else Print #f, "del ""%~f0""" End If Close f End Function Public Function CopactMyDb() On Error Resume Next Dim Mypath As String Mypath = CurrentProject.Path & "\" & CurrentProject.Name Call compactDb(Mypath, "", True) Shell """" & Left(Mypath, InStrRev(Mypath, "\")) & "\compact.bat""", 0 DoCmd.Quit acQuitSaveAll End Function ويتم الإستدعاء في أي زر = CopactMyDb Compact.accdb

اعتذر عن التأخير في المتابعة بسبب ظرف صحة

أهلا بك أخي @سيد رجب 🙂 فكرة البرنامج جميلة جدا وإبداعية .. لكن في التصميم الصحيح لقاعدة البيانات أنت في غنى عن الخطوات المعقدة التي ذكرتها 🙂 ستحتاج لجدول واحد فقط لحفظ بيانات الطلبات سواء الموافق عليها أو المكتملة أو التي في الانتظار .. فقط ستحتاج لإضافة حقل به قائمة منسدلة توضح حالة الطلب (انتظار - موافق عليه - مكتمل - مقبول - مرفوض) مثلا .. وبعد ذلك تعمل 5 استعلامات مثلا .. كل استعلام يعرض حالة واحدة للطلبات ( مثال : استعلام يعرض جميع الطلبات المكتملة فقط .. ) .. وهكذا لبقية الحالات .. ثم تجعل هذه الاستعلامات مصدر للنموذج الذي سيعرض الطلبات حسب الحالة المطلوبة ( مثال : نموذج لعرض الطلبات التي قيد الانتظار ) ( ونموذج لعرض الطلبات الموافق عليها ) وآخر للمكتملة وآخر للمرفوضة وهكذا .. ولنقل الطلبات من حالة إلى أخرى كل ما عليك فعله هو تقيير القيمة المكتوبة في حقل الحالة (يمكن عملها أوتوماتيكيا بالكود ) ... وستقوم الاستعلامات تلقائيا بنقل الطلب للتصنيف المناسب . ملاحظة : لن تحتاج لعمل ملفي أكسس ( واحد للمرسل والآخر للمستقبل ) .. ضع جميع النماذج والاستعلامات والتقارير في ملف واحد فقط ووزعه للمرسلين والمستقبلين (نفس الملف) .. اللهم عن طريق صلاحيات المستخدمين اجعل لكل مستخدم مساره الخاص حسب نوع المستخدم ( مرسل أو مستقبل ) ، لكل شخص تظهر له النماذج الخاصة به فقط .. بعد قراءة هذه الأسطر إبدأ في التطبيق والمعين الله 🌼🙂 .. وانتقل بعدها للخطوة التالية ..

وعليكم السلام ورحمة الله وبركاته 🙂 Database12.accdb

السلام عليكم ورحمة الله وبركاته في حال عدم وجود كلمة سر لقاعدة البيانات ... كيف يكون الكود جزاكم الله الخير

وعليكم السلام ورحمة الله وبركاته اخي @salah.sarea . ضع هذا الكود في حدث عند النقر لزر الإصلاح ، مع تحديد مسار قاعدة البيانات B_Be حسب ما تريد . Private Sub btnRepair_Click() Dim strConnect As String Dim strPassword As String strPassword = "123" strConnect = "MS Access;PWD=" & strPassword & ";DATABASE=path_to_b_be.accdb" Application.CompactRepair SourceFile:="path_to_b_be.accdb", DestinationFile:="path_to_b_be.accdb", _ Password:=strPassword MsgBox "تم إصلاح قاعدة البيانات بنجاح!", vbInformation End Sub طبعا على افتراض أن اسم الزر btnRepair.

🤐

عملت تعديل اخير ، ورفعته مكان المشاركة الاولى 🙂 مع ان جوابي هو ما ممكن ، ولكن اخونا العود @ابوخليل نصحني بعدم استعمال هذه العبارة ، فيمكن يجي مبرمج اشطر مني ، ويعطينا الحل 🙂 ممكن هنا اطلب من اخوي موسى @Moosak ان يحاول بلعبته الجديدة : اداة بحث ثورية ان يجد لنا الحل هناك 🙂 جعفر

السلام عليكم الاخ الكريم / aburajai بارك الله فيك لتنفيذ ما تريده قم بوضع الاكواد التاليه باكواد الفورم واليك ملف مرفق به فورم مع الاكواد المذكورة لالغاء الشريط الازرق من الفورم ( ترويسه الفورم ) Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Const WS_SYSMENU = &H80000 Private Sub UserForm_Initialize() On Error Resume Next Dim lngWindow As Long, lFrmHdl As Long lFrmHdl = FindWindow(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) End Sub Private Sub CommandButton1_Click() End End Sub جزاك الله خيرا الغاء الترويسه من الفورم.rar

هذا البرنامج سيساعد فى كتابة سطور الأكسيس حبسما تشاء . أشرف خليل msgbuilder_zip.exe