jjafferr

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

اما السؤال عن فائدة استخدام ملف pdf في المقارنة ، فلاحظت الخطوط في هذا التقرير ، اللي عليها الاسهم سميكة ، وما المفروض ان يصير هذا الشيء . ولكن لما صدرته الى ملف pdf وفتحته ، اتضح ان تقرير الاكسس لم يعطيني رؤية صحيحة للخطوط !! . جعفر

ما اعتقد له علاقة بالطابعة ، فأنا طابعتي هو طابعة pdf افتراضية !! بالنسبة لتجاربي ، فكانت بعكس طلبك ، يعني ما لاحقت سبب سمك التقرير ، وانما جعلت سمك التقرير ذو الخطوط الانحف يساوي نفس سمك التقرير الآخر. ولكني لاحقا حاولت معرفة سبب البرواز السميك ، ولم استطع ، بالرغم اني عملت تغيير للكثير من الاعدادات !!

انا جربت قبل ان اضع مشاركتي السابقة ، فللتقريرين كان BW=10 وللعلم ، فالامر BorderStyle = 0 يشمل البراوييز الداخليه (مكان Hide Duplicates) ، ولا يشمل البرواز الذي تناديه من Detail_Print ، لأنك لم تكتبه هناك ايضا !! جرب الكلام اللي اخبرتك في مشاركتي الاولى ، وشوف النتائج

بكلام آخر ، انظر الى البروازين (تكبير بنسبة 1600% بعد تصديرهم الى ملف pdf) ، الخارجي للتقرير rptReport1 ، والداخلي للتقرير qry_rpt1-test ، سترى انهما بنفس الحجم : . 1. قمت بتصدير qry_rpt1-test الى pdf كما هو : 20Pixel+10Pixels=30Pixels 2. غير الكود ، واجعل قيمة العرض = 30Pixel ، ثم قم بتصدير التقرير rptReport1 الى ملف pdf ، سترى ان البروازين اصبحوا بنفس الحجم 🙂

وعليكم السلام 🙂 1. انت سمحت لإظهار البرواز بعرض 1Point=20Pixel ، . 2. ثم عملت برواز بعرض 10Pixels عن طريق الكود . بينما في التقرير الثاني (الخطوط الاضعف) ، قمت بعمل البرواز عن طريق الكود فقط : . جعفر

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

شغل جميل 🙂 بدل تخزين البيانات في الجدول ، انا استعملت Array لحل الموضوع ، وانت موضوعك اسهل لأنك استعملت عمودين فقط 🙂 جعفر

وعليكم السلام اخي عمر 🙂 شكرا لك لمشاركتك هذا المجهود الكبير ، والمطلوب دائما 🙂 حصلت لي بعض الاشكالات عند فتح البرنامج ، فياريت تعالجها ثم ترفق التعديل : 1. هل انت بحاجة الى جميع هذه المكتبات ؟ انا ظهرت عندي مشكلة في عدم وجود برنامجين (لاحظ كلمة Missing) ، وتوقف البرنامج الى ان حذفت اشارة الصح √ من امام المكتبتين : . 2. الرسالة التالية كانت تشتكي لعدم وجود برنامج الجداول في المكان الذي برمجته انت فيه ، فاقترح عليك ان تضع كود يفتح نافذة اختيار الملف ، ويطلب من المستخدم التوجه له واختياره . 3. وبعد تعدي المشكلتين اعلاه ، توقفت عند هذا النموذج ، فلم اعرف ما يجب ان افعله !! . جعفر

نعم كان مرهق ، واوقفت تقريبا جميع اعمالي بس علشان اكمله !! اذا الله سبحانه وتعالى قدّرني ، بكرة ان شاء الله اكتب تفاصيل العمل 🙂 محاولاتي الاولى فشلت 😞 اتمنى ابو احمد يقدر يضيف هذه الفقرة في برنامجه ان شاء الله 🙂 جعفر

البرنامج جميل وسريع 🙂 جعفر

السلام عليكم 🙂 تفضل اخي هاني ، هذا الرابط به تقريرك . جعفر

السلام عليكم 🙂 الحمدلله انتهيت من المشروع ، وهذا رابطه جعفر

السلام عليكم 🙂 اذا عندنا تقرير بهذه الطريقة: . اليس الافضل دمج بيانات الحقل المتكررة عموديا في حقل واحد ، مثل الوورد مثلا الى : . طريقة العمل : 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

سبحان الله ، نرجع الى اصل الوندوز ، الدوز DOS 🙂 شكرا جزيلا لك اخوي خالد 🙂 جعفر

بدل ان نجعل مصدر بيانات حقل الترقيم =1 ، اجعله =25 ، وهو اول عدد يتم به الترقيم ، وطبعا علشان يتم الترقيم ، لازم يكون عندنا Running Sum على مستوى المجموعة او مستوى التقرير كاملا : . جعفر

في استعلام التقرير ، اعمل معيار في احد الحقول ، مثل رقم الجلوس ، هكذا : . ومعيار الاستعلام التقرير الآخر : . وهذه النتيجة : . جعفر

وعليكم السلام 🙂 ابو احمد ، ابشرك ، خلصت كل شيء ، بس احتاج وقت لترتيب الكود وتسهيله للمستخدم 🙂 جعفر

1. مع الاخفاء ، اجعل عرض الحقل=0 ، 2. بالنسبة للمحاذاة ، تحتاج الى عمل حقل فارغ يملئ المسافة من اليسار ، بحيث يتم زحف/تحريك بقية الحقول الى اليمين. واذا اردت مساعدة اضافية ، يجب ان نرى مرفقك وبه بيانات كافية للتجارب عليه 🙂 جعفر

انا استعملها دائما ، والفكرة ناجحة 🙂 انت سترى المجلد من كمبيوترك ، ولكن بقية الكمبيوترات في الشبكة لن تراه

شكرا لك اخي ابو جودي على التصحيح 🙂 ورجاء مرة ثانية ، اخبرني مباشرة في الموضوع ، فلا عيب ولا استحياء من ان نُخطئ ، فنحن بشر 🙂 رجاء ملاحظة تصحيح اخي ابو جودي ، ان علامة الدولار بعد الاسم وليس قبله 🙂 جعفر

دكتور حلبي ، هل جربت الطريقة ؟

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

وعليكم السلام ورحمة الله وبركاته 🙂 تفضل يا سيدي ، دالة تحذف المجلد واللي فيه : Function DelFolder(ByVal strDir As String) As Long On Error Resume Next ' to delete the directory and its contents Dim x As Long Dim intAttr As Integer Dim strAllDirs As String Dim strFile As String DelFolder = -1 strDir = Trim$(strDir) If Len(strDir) = 0 Then Exit Function If right$(strDir, 1) = "\" Then strDir = Left$(strDir, Len(strDir) - 1) If InStr(strDir, "\") = 0 Then Exit Function intAttr = GetAttr(strDir) If (intAttr And vbDirectory) = 0 Then Exit Function strFile = Dir$(strDir & "\*.*", vbSystem Or vbDirectory Or vbHidden) Do While Len(strFile) If strFile <> "." And strFile <> ".." Then intAttr = GetAttr(strDir & "\" & strFile) If (intAttr And vbDirectory) Then strAllDirs = strAllDirs & strFile & Chr$(0) Else If intAttr <> vbNormal Then SetAttr strDir & "\" & strFile, vbNormal If Err Then DelFolder = Err: Exit Function End If Kill strDir & "\" & strFile If Err Then DelFolder = Err: Exit Function End If End If strFile = Dir$ Loop Do While Len(strAllDirs) x = InStr(strAllDirs, Chr$(0)) strFile = Left$(strAllDirs, x - 1) strAllDirs = Mid$(strAllDirs, x + 1) x = DelFolder(strDir & "\" & strFile) If x Then DelFolder = x: Exit Function Loop RmDir strDir If Err Then DelFolder = Err Else DelFolder = 0 End If End Function جعفر

وعليكم السلام اخي احمد 🙂 اهلا وسهلا بك في المنتدى 🙂 للإستفادة القصوى من المنتدى ، يرجى قراءة قوانين المنتدى: اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة رجاء شرح طلبك بصورة ، او عمله بالاكسل ، فلم افهم المطلوب 🙂 جعفر