jjafferr

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

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

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

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

ياريت تخبرنا عن طريقة بحثك للمواضيع ، لأني ملاحظ انك ما شاء الله عندك بنك من المعلومات الجاهزة (نقدا cash) 🙂 اعمل تقرير جديد ، ضع فيه التقريرين Rep_1 و Rep_2 كتقارير فرعية جنب بعضهم كما في الصورة ، و اضبط المسافات وحواشي الطباعة 🙂 جعفر

اذا عندك مجلد مشاركة في شبكة ، وكان هذا المجلد على السيرفر او كمبيوترك ، وما تريد بقية الكمبيوترات تشوفه ، اكتب علامة الدولار قبل الاسم ، مما سيجعل المجلد مخفي لبقية الكمبيوترات على الشبكة ، ولن يروه 🙂 مثل: $myFolder جعفر هذا يشتغل على صيغة mdb ولا يشتغل على صيغة accdb ، وتأكد بأن كلمة السر طولها 12 حرف واطول ، وفيها حروف كبيرة وصغيرة وارقام ورموز (مثل ! @ # $ % ^ & * ) ( _ + = ) جعفر

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

اعمل للبرنامج كلمة سر 🙂 شو المشكلة !! جعفر

وعليكم السلام ورحمة الله وبركانه 🙂 . . . جعفر

وعليكم السلام 🙂 من الصورة اللي ارفقتها ، اشوف انك ما اخترت المجلد اللي يحفظ فيه النسخ الاضافية !! افتح البرنامج ، اضغط على الزر F11 من الكيبورد ، افتح الجدول tbl_Backup_Path ، وبدل المسار: Y:\Sharing\DBs\DB_Backup ، اكتب مسار مجلد النسخ الاضافية ، اقفل البرنامج ، ثم شغله من جديد 🙂 جعفر

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

عفوا يا جماعة ، الخطأ مني 😪 استعملوا هذا السطر Source_File_Path = Me.Parent!pate & "\" & Me.name_morfke . يعني كودي في اول مشاركة يصبح بعد التعديل : Private Sub name_morfke_Click() Dim Source_File_Path As String, Destination_File_Path As String Source_File_Path = me.parent!pate & "\" & Me.name_morfke Destination_File_Path = Environ("Temp") & "\" & Me.name_morfke FileCopy Source_File_Path, Destination_File_Path Application.FollowHyperlink (Destination_File_Path) EcryptDcryptImage (Destination_File_Path) End Sub Private Sub Form_Close() On Error Resume Next Dim Srst As DAO.Recordset Set Srst = Me.RecordsetClone Do Until Srst.EOF Kill Environ("Temp") & "\" & Srst!name_morfke Srst.MoveNext Loop End Sub . واليكم المرفق وبه التعديلات السابقة والاخيرة والجديدة 🙂 جعفر Archiving_Encripted_Attachment.zip

وين البيانات او الصورة ؟

السلام عليكم 🙂 بوجه عام ، يمكنك عمل ملصقات في الاكسس تتناسب مع حجم الملصق ، من هنا : . اذا عندك اسم شركة الملصق ، فيمكنك البحث في رقم 1 ، ثم تختار الحجم من القائمة في الاعلى ، واذا الملصق عام ، فيمكنك عمل ملصق خاص بك بالقيام بالخطوات 2-4 : . وطبعا تقدر تضبط الحقول وحجمها داخل حدود الملصق 🙂 جعفر

لوسمحت تجرب هذا الكود بدلا عن السابق: Private Sub name_morfke_Click() Dim Source_File_Path As String, Destination_File_Path As String Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Source_File_Path = CurrentProject.Path & "\" & Me.name_morfke 'Destination_File_Path = Environ("Temp") & "\" & Me.name_morfke Destination_File_Path = fso.GetSpecialFolder(2) & "\" & Me.name_morfke If Dir(Source_File_Path) = "" Then Debug.Print Source_File_Path & " > Not Found" Else Debug.Print Source_File_Path & " > Found" End If If Dir(Environ("Temp"), vbDirectory) <> "" Then Debug.Print Environ("Temp") & " > Found" End If If Dir(fso.GetSpecialFolder(2), vbDirectory) <> "" Then Debug.Print fso.GetSpecialFolder(2) & " > Found" End If 'FileCopy Source_File_Path, Destination_File_Path fso.CopyFile Source_File_Path, Destination_File_Path, True Application.FollowHyperlink (Destination_File_Path) EcryptDcryptImage (Destination_File_Path) End Sub . ثم الصق لنا النتيجة التي في اسفل نافذة الكود VBA ، كما في الصورة في الاسفل : . جعفر