Foksh

حال وصولي للكمبيوتر بإذن الله تعالى 😇

الفكرة العامة واضحة أخي الكريم.. أعتقد هناك طريقة افضل ، ولكن دعنا نتفق على آلية جديدة للسير في طريق صحيح .. 1. لا أنصحك باستخدام أسماء مركبة من مقطعين ( يفصل بينها فراغ ) كأسماء الجداول أو الحقول أو الاستعلامات .... إلخ . السبب أنك ستواجه مشكلة كبيرة في كتابة الأكواد والإستدعاء لعنصر داخل الـ VBA ( على سبيل المثال ) . 2. استخدم فكرة جدول العقود والمرتبط بجدولي العملاء والسيارات ( فكرة الجدول الواحد ) 3. كيف تختار في تصميمك اسم الزبون ( العميل ) ؟؟؟ من كمبيوبوكس أم تقوم بكتابة الاسم بشكل يدوي ؟؟ اذا كان من خلال كومبوبوكس فهو حتماً سيكون موجود مسبقاً في جدول العملاء ، صحيح ؟؟ إذا ما الحاجة لادخال البيانات في جدول العملاء (اقتباساً من كلامك ) :- اذاً عدنا للحاجة الى ادخال البيانات في جدول واحد فقط وليس 3 جداول والأمر نفسه ينطبق على جدول السيارات أيضاً ، صحيح !!!!! أتمنى أن أكون قد وُفقت في توضيح فكرتي والتي أعتقد أنها ستوفر عليك الكثير من الجهد و الوقت .

ممتاز .. هل لك ان ترفق ملفك بعد هذه الإضافة المهمة ، واعتقد انه يجب ان لا تتقيد بالقيم الموجودة في الكومبوبوكس Etar كأنها Value list ، والأصح بالنسبة لي هو ان يكون لها جدول مستقل لإضافتها وتحريرها مستقبلاً ( هذه الفكرة إختياري وليس إجباري طبعاً ) . بانتظار ملفك المعدّل

طريقة تعامل اكسيس مع استعلامات الغير قابلة للتحديث قد تكون مختلفة بين الإصدارات القديمة والحديثة , * وجهة نظر

وعليكم السلام ورحمة الله وبركاته .. مصدر سجلات النموذج استعلام ، وللأسف الإستعلام غير قابل للتحديث بإضافة سجل جديد .

لتنفيذ هذه الفكرة ، يمكن اتباع الخطوات التالية :- 1. تحديد مسار حفظ الملفات لكل شعبة داخل مجلد مشترك على الشبكة ، قم بإنشاء مجلد رئيسي مثل \\Server\Documents\Books\ أنشئ داخله مجلدات لكل شعبة ، مثل :- \\Server\Documents\Books\Accounts 'قسم المحاسبة \\Server\Documents\Books\HR 'قسم شؤون الموظفين وأي اقسام أخرى حسب رغبتك طبعاً 2. إضافة جدول لحفظ بيانات الشعب في قاعدة البيانات أنشئ جدولاً جديداً باسم tblDepartments على سبيل المثال ، يحتوي على :- ID (رقم تلقائي) DeptName (اسم الشعبة) FolderPath (مسار مجلد الشعبة في الشبكة) 3. تصميم نموذج لاختيار الشعبة وإرسال الملف أضف نموذجاً جديداً باسم frmSendDocument أضف مربع قائمة منسدلة (ComboBox) مصدره جدول الشعب (tblDepartments) أضف زر إرسال يقوم بنسخ الملف إلى مجلد الشعبة المختارة . 4. الكود التالي لنقل الصورة إلى مجلد الشعبة المختارة عند الضغط على زر الإرسال ، استخدم الكود التالي :- Private Sub btnSend_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSourceFile As String Dim strDestinationFile As String Dim strDeptPath As String ' تحديد قاعدة البيانات Set db = CurrentDb Set rs = db.OpenRecordset("SELECT FolderPath FROM tblDepartments WHERE DeptName='" & Me.cboDepartment & "'", dbOpenSnapshot) ' التحقق من العثور على مسار الشعبة If Not rs.EOF Then strDeptPath = rs!FolderPath strSourceFile = Me.txtFilePath ' مسار الملف الأصلي strDestinationFile = strDeptPath & "\" & Dir(strSourceFile) ' نسخ الملف إلى مجلد الشعبة FileCopy strSourceFile, strDestinationFile MsgBox "تم إرسال الصورة إلى " & Me.cboDepartment, vbInformation Else MsgBox "لم يتم العثور على مسار الشعبة", vbCritical End If rs.Close Set rs = Nothing Set db = Nothing End Sub 5. برنامج الاستقبال في الأجهزة المستهدفة في البرنامج الخاص بكل شعبة ، يمكن عمل نموذج يقوم بفحص المجلد المحدد وعرض الملفات الجديدة . يمكن استخدام كود VBA لإنشاء زر تحديث يقوم بعرض الملفات الواردة تلقائياً . 6. ملاحظات حول الربط الشبكي تأكد أن جميع الأجهزة متصلة بالشبكة المحلية (Switch أو Router) . قم بمشاركة المجلد الرئيسي وإعطاء الصلاحيات المناسبة للمستخدمين . هذا تصور مبدئي للفكرة ، وتختلف آلية التنفيذ حسب طريقة تصميم مشروعك وبرنامجك .

وعليكم السلام ورحمة الله وبركاته .. جرب أخي الكريم ما يلي :- 1- افتح CMD كمسؤول . 2- اكتب الأمر التالي سطراً تلو الآخر .. regsvr32 /u fm20.dll regsvr32 fm20.dll الهدف تحديث أو إعادة تسجيل مكتبات VBA فقط .

وعليكم السلام ورحمة الله وبركاته .. سؤال لولبي ، ما الرابط بين الكومبوبوكس Etar والجداول التي تريد جلب القيم منها ؟؟؟؟

وعليكم السلام ورحمة الله وبركاته.. راجع هذا الموضوع:- https://www.officena.net/ib/topic/19137-تمت-الاجابة-إظهار-التاريخ-الهجري-والميلادي-في-تقرير/#comment-86999

اعتذر منك ، حاولت ولكن محاولاتي لم تنجح للأسف . آملاً أن تجد الحل الذي يحل لك مشكلتك يا صديقي

لا تبخل علينا في ملف مرفق يحتوي تقرير مماثل لما وصفته ( لا يشترط الجداول ولا اي نماذج )

وعليكم السلام ورحمة الله وبركاته ،، من مشروع قديم ، جرب هذا الكود في زر . مع العلم أنني لم أصل الى حجم الورقة A2 مثلاً Dim rpt As Report DoCmd.openReport "Report4", acViewPreview Set rpt = Reports("Report4") rpt.Printer.PaperSize = acPRPSA4 rpt.Printer.LeftMargin = 200 rpt.Printer.RightMargin = 200 rpt.Printer.TopMargin = 200 rpt.Printer.BottomMargin = 200 DoCmd.PrintOut DoCmd.Close acReport, "Report4", acSaveNo

صدقني اعتذر منك على التأخير .. الملف مفتوح المصدر . Update.accdb

100% 👍

خلاصة القول عن ما تفضل به الأستاذ @أبوبسمله : الجزء المسؤول عن حجم QR Code غير موجود في الكود ، ولكن يمكن التحكم به بإضافة scale=X حيث X هو معامل التكبير المناسب لحاجتك . حيث scale=2 يزيد حجم QR Code ، ويمكنك تغيير الرقم حسب الحاجة .

جهود جميلة منكم أخي الكريم ، واسمحلي بسؤال يدور في ذهني !! هل تمت التجربة على هذا الكود ؟؟؟؟؟؟؟؟؟؟؟؟؟

وعليكم السلام ورحمة الله وبركاته.. أخي الكريم طلبك غير منطقي ، والسبب ان التقرير سيكون مبني على جداول أو استعلامات ، صحيح ؟؟؟؟؟؟؟

في هذه الحالة ، سنقوم باستعمال مصفوفة بسيطة على سبيل المثال لتحديد الإستعلامات التي موجودة لديك ، كالتالي :- Sub ExportQueriesToExcel() Dim xlApp As Object Dim xlWorkbook As Object Dim xlWorksheet As Object Dim db As DAO.Database Dim rs As DAO.Recordset Dim queryNames As Variant Dim sheetIndex As Integer Dim filePath As String Dim colIndex As Integer Dim rowIndex As Integer queryNames = Array("Qallmsr2", "Qallshm2", "Qallshy2", "Qalltipr2") filePath = Application.CurrentProject.Path & "\تقرير_الاكسيل.xlsx" Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Set xlWorkbook = xlApp.Workbooks.Add Set db = CurrentDb sheetIndex = 1 For Each queryName In queryNames Set rs = db.OpenRecordset(queryName, dbOpenSnapshot) If sheetIndex <= xlWorkbook.Sheets.Count Then Set xlWorksheet = xlWorkbook.Sheets(sheetIndex) Else Set xlWorksheet = xlWorkbook.Sheets.Add End If xlWorksheet.Name = queryName colIndex = 1 For Each fld In rs.Fields xlWorksheet.Cells(1, colIndex).Value = fld.Name xlWorksheet.Cells(1, colIndex).Font.Bold = True colIndex = colIndex + 1 Next fld rowIndex = 2 Do While Not rs.EOF colIndex = 1 For Each fld In rs.Fields xlWorksheet.Cells(rowIndex, colIndex).Value = fld.Value colIndex = colIndex + 1 Next fld rowIndex = rowIndex + 1 rs.MoveNext Loop rs.Close sheetIndex = sheetIndex + 1 Next queryName xlWorkbook.SaveAs filePath xlWorkbook.Close xlApp.Quit Set rs = Nothing Set db = Nothing Set xlWorksheet = Nothing Set xlWorkbook = Nothing Set xlApp = Nothing MsgBox "تم تصدير البيانات بنجاح", vbInformation + vbMsgBoxRight, "نجاح العملية" End Sub test.accdb

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

هل هذا ما تقصده ؟؟ SELECT TIP.*, TSHM.*, TSHY.[id] AS TSHY_id, TSHY.*, Ttipr.[id] AS Ttipr_id, Ttipr.*, Tmsr.[id] AS Tmsr_id, Tmsr.[No], Tmsr.[اسم المادة], Tmsr.[مبلغ الصرف], Tmsr.data, Tmsr.Year FROM ((((TIP LEFT JOIN TSHM ON TIP.id = TSHM.[id]) LEFT JOIN TSHY ON TIP.id = TSHY.[id]) LEFT JOIN Ttipr ON TIP.id = Ttipr.[id]) LEFT JOIN Tmsr ON TIP.id = Tmsr.[id]);

لا اعلم ان كان ما فهمته صحيح ، تفضل هذا الاستعلام ، وأخبرنا بالنتيجة ,, TRANSFORM Sum([Competitor Analysis].Premium) AS SumOfPremium SELECT [Competitor Analysis].clint_code FROM [Competitor Analysis] GROUP BY [Competitor Analysis].clint_code PIVOT [Competitor Analysis].company; test (1).accdb

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

تفضل فكرتي المتواضعة ، حيث سيتم أولاً تحميل أسماء الاستعلامات في الليست بوكس ، وانت تختار ما تريده ، ثم انقر الزر للتصدير :- Private Sub Export_Selected_Queries() Dim xlApp As Object, xlWorkbook As Object, xlWorksheet As Object Dim db As DAO.Database, rs As DAO.Recordset Dim sheetIndex As Integer, colIndex As Integer, rowIndex As Integer Dim filePath As String, queryName As String Dim i As Variant filePath = Application.CurrentProject.Path & "\تقرير_الاكسيل.xlsx" If Me.Que_List.ItemsSelected.Count = 0 Then MsgBox "يرجى تحديد استعلام واحد على الأقل قبل التصدير", vbExclamation + vbMsgBoxRight, "خطأ" Exit Sub End If Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Set xlWorkbook = xlApp.Workbooks.Add Set db = CurrentDb sheetIndex = 1 For Each i In Me.Que_List.ItemsSelected queryName = Trim(Me.Que_List.ItemData(i)) Set rs = db.OpenRecordset(queryName, dbOpenSnapshot) If sheetIndex <= xlWorkbook.Sheets.Count Then Set xlWorksheet = xlWorkbook.Sheets(sheetIndex) Else Set xlWorksheet = xlWorkbook.Sheets.Add End If xlWorksheet.Name = queryName colIndex = 1 With xlWorksheet For Each fld In rs.Fields .Cells(1, colIndex).Value = fld.Name .Cells(1, colIndex).Font.Bold = True colIndex = colIndex + 1 Next fld rowIndex = 2 Do While Not rs.EOF colIndex = 1 For Each fld In rs.Fields .Cells(rowIndex, colIndex).Value = fld.Value colIndex = colIndex + 1 Next fld rowIndex = rowIndex + 1 rs.MoveNext Loop End With rs.Close sheetIndex = sheetIndex + 1 Next i xlWorkbook.SaveAs filePath xlWorkbook.Close xlApp.Quit On Error Resume Next Set rs = Nothing Set db = Nothing Set xlWorksheet = Nothing Set xlWorkbook = Nothing Set xlApp = Nothing On Error GoTo 0 MsgBox "تم تصدير البيانات بنجاح", vbInformation + vbMsgBoxRight, "نجاح العملية" End Sub test.accdb

سلمك الله وعافاك أخي الأستاذ @kkhalifa1960 ،

ليس للـ Check Box علاقة بالأمر ، الأمر هو ان الحقل يحتوي على حروف عربية وانجليزية !!!