AbuuAhmed

لإضافة التسميات لقسم رأس الصفحة للتقرير في طور التصميم لتنظيم التسميات لقسم رأس الصفحة للتقرير في طور التشغيل 'AbuuAhmed, Officena.net '2023/06/15 Sub AddReportPageHeaderLabels(rptName As String) Dim acr As Byte, acrs As Byte Dim col As Byte Dim rpt As Report Dim ctl As Control, lbl As Control Dim lblName As String 'لإضافة التسميات في قسم رأس الصفحة للتقارير متكررة الأعمدة في طور التصميم 'On Error Resume Next DoCmd.OpenReport rptName, acViewDesign, , , acHidden Set rpt = Reports(rptName) acrs = rpt.Printer.ItemsAcross With rpt.Section(acPageHeader) Do While .Controls.Count > 0 For Each ctl In .Controls Call DeleteReportControl(rptName, ctl.Name) Next ctl Loop For acr = 1 To acrs col = 0 For Each ctl In rpt.Section(acDetail).Controls col = col + 1 lblName = "col" & Format(col, "00") & Format(acr, "_00") Set lbl = CreateReportControl(rptName, acLabel, acPageHeader, , lblName) lbl.Name = lblName lbl.Caption = IIf(ctl.Tag = "", ctl.Name, ctl.Tag) lbl.ControlTipText = ctl.Name lbl.Left = ctl.Left lbl.Width = ctl.Width lbl.Top = lbl.Height * (acr - 1) lbl.TextAlign = 2 lbl.BorderStyle = 1 lbl.BackStyle = 1 lbl.BackColor = RGB(216, 216, 216) Next ctl Next acr .Height = 0 End With DoCmd.Close acReport, rptName, acSaveYes Set rpt = Nothing Set ctl = Nothing Set lbl = Nothing MsgBox "Done" End Sub Sub ReportOpen4PageHeader(rptName As String) Dim col As Byte, cols As Byte Dim acr As Byte, acrs As Byte Dim rpt As Report Dim ctl0 As Control, ctl1 As Control, ctl2 As Control 'لتنظيم التسميات في قسم رأس الصفحة للتقارير متكررة الأعمدة في طور التشغيل On Error Resume Next Set rpt = Reports(rptName) rpt.Printer.ItemLayout = acPRVerticalColumnLayout rpt.Printer.DefaultSize = False cols = rpt.Section(acDetail).Controls.Count acrs = rpt.Printer.ItemsAcross For Each ctl0 In rpt.Section(acPageHeader).Controls With rpt.Controls(ctl0.ControlTipText) ctl0.Left = .Left ctl0.Width = .Width End With Next ctl0 Set ctl0 = rpt("col" & Format(cols, "00") & "_01") rpt.Width = rpt.WindowWidth For acr = 2 To acrs For col = 1 To cols Set ctl1 = rpt("col" & Format(col, "00") & "_01") Set ctl2 = rpt("col" & Format(col, "00") & Format(acr, "_00")) With ctl2 .Left = ctl0.Left + ctl0.Width + IIf(col = 1, rpt.Printer.ColumnSpacing, 0) .Top = ctl1.Top '.Width = ctl1.Width .Height = ctl1.Height .BackColor = ctl1.BackColor .ForeColor = ctl1.ForeColor .BackStyle = ctl1.BackStyle .Caption = ctl1.Caption End With Set ctl0 = ctl2 Next col Next acr rpt.Width = 0 With rpt.Section(acPageHeader) .Height = 0 .Height = .Height + rpt("col01_01").Top End With Set rpt = Nothing Set ctl0 = Nothing Set ctl1 = Nothing Set ctl2 = Nothing End Sub حل للتقارير متعددة الأعمدة_01.accdb

جرب هذا المثال وبه استعانة بالكود ويمكن عمل كود آخر أثناء التصميم لتكرار صناديق التسميات إذا أحببت. Private Sub Report_Open(Cancel As Integer) Dim col As Byte, cols As Byte Dim acr As Byte, acrs As Byte Dim ctl0 As Control, ctl1 As Control, ctl2 As Control On Error Resume Next Me.Printer.ItemLayout = acPRVerticalColumnLayout Me.Printer.DefaultSize = False cols = Me.Section(0).Controls.Count acrs = Me.Printer.ItemsAcross Set ctl0 = Me("col" & Format(cols, "00") & "_01") Me.Width = Me.WindowWidth For acr = 2 To acrs For col = 1 To cols Set ctl1 = Me("col" & Format(col, "00") & "_01") Set ctl2 = Me("col" & Format(col, "00") & Format(acr, "_00")) With ctl2 .Left = ctl0.Left + ctl0.Width + IIf(col = 1, Me.Printer.ColumnSpacing, 0) .Top = ctl1.Top .Width = ctl1.Width .Height = ctl1.Height .BackColor = ctl1.BackColor .ForeColor = ctl1.ForeColor .BackStyle = ctl1.BackStyle .Caption = ctl1.Caption End With Set ctl0 = ctl2 Next col Next acr Me.Width = 0 With Me.Section(3) .Height = 0 .Height = .Height + Me.col01_01.Top End With Set ctl0 = Nothing Set ctl1 = Nothing Set ctl2 = Nothing End Sub تكرار عنوان التقرير_02.accdb

ويا أخ موسى الإشراف عندك هو حذف كل ما فيه انتقاد للمشرفين؟!!! دع التعليقات إذا لا يوجد بها سباب أو إساءات. ولعلمك هناك الكثير مما لا يقال أو يقال بشكل مباشر مثلا قد تتفاجأ أن ثلاثة معرفات في هذا الموضوع لشخص واحد، يعني ثلاثة في واحد. ولهم رابع لسى ما دخل على الموضوع 🙂

إذا كان فهمي صحيح، فطلبك غير واضح بشكل كاف. أنا بدلت الشرط: [LastEdit]="..." إلى: [LastEdit]<="..." وإذا رأيت أن الفكرة مقولبة فعدل الشرط إلى: [LastEdit]>="..." سجل بجميع التعديلات_02.accdb

يفترض بصاحب الموضوع متابعة موضوعه.

ارفع مثال أفضل لكم ولنا 🙂 وخصوصا أن الكود طويل، لاحظت بعض الأخطاء وربما هي ليس أخطاء فارفع مثالك لنعرف السبب وإذا عرف السبب .....

راجعت عمل الزميل دروب مبرمج، وأعجبني أنه أحتاج حقل واحد فقط وهو رقم المجموعة وهذا فيه توفير للمساحة. العمل ممتاز ولكن الزميل لم يلتفت لملاحظة السائل وائل طه والموضحة أعلاه. أما الكود فرأيت أن هذين السطرين لا يعملان، هل هما مطلوبان أم متروكان وتم نسيان أزالتهما؟: DoCmd.RunSQL "ALTER TABLE ]" & Tabel_Name & "] DROP COLUMN Str_Group" DoCmd.RunSQL "ALTER TABLE ]" & Tabel_Name & "] ADD Str_Group Number" أرفق لكم القاعدة لفكرتي فقط حتى لا تشتت الفاحص للمثال. مع ملاحة أني بدلت رقم السجل 4 إلى 400000 وحذف السجل الأخير لزوم التجارب. تقسيم مجموعات_أبو أحمد_03.mdb

تعديل للكود السابق: Private Sub Command1_Click() Dim strDB As String On Error Resume Next Set appAccess = CreateObject("Access.Application") Err.Clear strDB = CurrentProject.Path & "\FolderN\" & Me.n_Folder & "\" & Me.program & ".accdb" appAccess.OpenCurrentDatabase strDB 'If Err.Number <> 0 Then If Err.Number = 7866 Then strDB = CurrentProject.Path & "\FolderN\" & Me.n_Folder & "\" & Me.program & ".mdb" appAccess.OpenCurrentDatabase strDB End If appAccess.DoCmd.OpenForm Me.form_open appAccess.Visible = True Set appAccess = Nothing End Sub

طبعا دالة ترتيب السجل ثلاثة أرباعها أسطر زائدة، وذلك لأني بنيت الدالة على فكرة مختلفة ثم عدلت عنها في آخر الوقت ولم أقم بتنظيف الكود وتنقيحه. الدالة بعد التنقيح: Function GetSeq(ID As Long, Expr As String, Domain As String) As Long GetSeq = DCount(Expr, Domain, Expr & " <= " & ID) End Function سأقوم الليلة إن شاء الله بمراجعة مشاركة الزميل دروب مبرمج وأرجع لكم.

جرب هذا الكود: Private Sub Command1_Click() Dim strDB As String strDB = CurrentProject.Path & "\FolderN\" & Me.n_Folder & "\" & Me.program & ".accdb" Set appAccess = CreateObject("Access.Application") appAccess.OpenCurrentDatabase strDB appAccess.DoCmd.OpenForm Me.form_open appAccess.Visible = True Set appAccess = Nothing End Sub

تم عمل دالة للحصول على رقم ترتيب السجل ومن ثم الحصول على رقم المجموعة من خلال الإستعلام. اسم الاستعلام Query3 يعاب على الدالة أنها بطيئة لأنها تقوم بفتح الجدول بعدد السجلات ولكنها تغنيكم عن تخزين/حفظ قيمة الترتيب والمجموعة. إذا عجبتكم الفكرة غدا بإذن الله أفكر معكم في الخطوة الثانية. والاستعلام Query4 لعرض أول وآخر رقم لكل مجموعة. تقسيم الى مجموعات.accdb_02.mdb

أيضا جرب هذا الكود: Private Sub Form_Current() Dim Msg As String If IsNull(Me.adadno) Then Exit Sub 'If Me.adadno <> DLookup("[A]", "[Database]", "[crn] ='" & Me.adadno & "'") Then 'إذا كان الحقل نصي If Not IsNull(DLookup("[crn]", "[Database]", "[crn]=" & Me.adadno)) Then Msg = "القيمة " & Me.adadno & " موجودة هل تريد تكرارها؟" Beep If vbYes = MsgBox(Msg, vbQuestion + vbYesNo + vbDefaultButton2, "تننبيه") Then Exit Sub Else Undo 'Exit Sub End If End If End Sub

حولوا المرفق إلى 2003 خلوني أحاول معكم.

توجد مشكلة في الكود، عن طريق اختيار "التصحيح" debuging وسيقف المحرر على السطر مباشرة.

ذكرتني بجاري "الظابط" دايما يردد هالكلمة وجاري هذا عنده مسكلة في الفهم، أنا لا أتكلم عنك لا سمح الله فأنت إنسان راقي، أن أتكلم عن جاري.

وأنت أحسن الكتابة والوصف، إثنان غيري لم يفهما عبارتك إلا لما أجبت على سؤال أبي خليل. وأنا الحمد لله أحس الظن بالله ولكن لا أحب المجاملات ولا أقبل التصرفات السيئة وغير المحترمة وغير المسئولة من أي أحد كان.

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

هذا الموضوع ذكرني بموضوع شاركت فيه وصاحبه يعاني وسيستمر يعاني إن لم يسمع الكلام ويستفيد من نصائح الخبراء: إذا كان الموضوع له علاقة بالوقت فالأمر يختلف ولكن إذا كان الأمر له علاقة بالتواريخ فلننتبه إلى التالي والفرق بينها: في المدد هناك: - نهاية المدة (آخر يوم في المدة) End Date أو Last Date أو To Date - تاريخ الإنتهاء أو تاريخ الإستئناف أو تاريخ مباشرة العمل بعد انقطاع (أول يوم بعد انتهاء مدة إجازة مثلا) Expiry Date أو Resume Date فشهر يناير يبدأ من 01/01 وينتهي في 31/01 وليس 01/02 ومدته ستكون 31 يوم والأسبوع يبدأ بالأحد وينتهي بالسبت وليس الأحد ومدته ستكون 7 أيام فلنحسن المسمى لنحسن الحساب، لا أريد أن أتكلم عن خبراتي حتى لا تتعرفوا على شخصيتي الأصل 🙂 لو سأحسب الغياب لموظف غاب يوم 5 يناير سأسجله في جدول يحتوي على حقلين مثلا سيكون غيابه من 05/01 إلى 05/01. تحبون تعقدونها على الرجال عقدوها كما تعقد صاحبنا في الموضوع المشار إليه أعلاه 🙂 . ولا أستبعد من تواصل معه عبر الرسائل وقدم له نصيحة خاطئة.

احمع عليها واحد الحسبة الصح هي : تاريخ الاستلام - تاريخ التسليم + 1

طيب جميل والحمد لله أن الصورة اتضحت، فتعليقي لم يكن لانتقاصك ولكن هو حوار برمجي علمي. 'دالة من عمل أبي أحمد وأبي جودي Function vbCEILING2(ByVal Num As Double, Optional ByVal Significance As Double = 1) As Double Dim Frac As Double Num = Num / Significance Frac = Num - Int(Num) vbCEILING2 = Int(Num) * Significance + IIf(Frac = 0, 0, Significance) End Function Test4myRoundFunctions_04.xlsm

أنت قمت بتعديل مشاركتك وباستخدام صلاحياتك الإدارية!! بحيث لا تظهر ملاحظة التعديل 🙂 هذا تعديلك الأول والذي أنا علقت عليه: Function myRound2(ByVal Num As Double, Optional ByVal Factor As Double = 1) As Double Dim Frac As Double Num = Num / 10 Frac = Num - Int(Num) Frac = IIf(Frac = 0, 0, IIf(Frac > 0.5, 10, Factor)) myRound2 = Int(Num) * 10 + Frac End Function وهذا ملف اكسل به المقارنات 🙂 Test4myRoundFunctions_02.xlsm

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

هذه مشاركة فيها تطبيق لتخميني لا تعتمدها إلا إذا كنت متأكدا منها. عندما تتأكد 100% من اختيارك قم بتبديل اختيارك لأفضل إجابة إما للمرفق WM2000_06 أو WM2000_07 WM2000_07.mdb

كنت قد كتبت 4 دوال سابقا، ولكني نسيتها، ولو تذكرتها لاكتفيت بها 🙂

لن تعطي نتائج صحيحة وخصوصا أنها مصممة للعامل 5 فقط ، كذلك تعديلك لم يكن موفقا لأن هذا السطر يجب أن يكون كالتالي، وهذا لا يعني كذلك أنها تصلح لغير العامل 5 أيضا. Frac = IIf(Frac = 0, 0, IIf(Frac > 0.5, 2, 1)) * Factor