أبو إبراهيم الغامدي

هذا تبرير منطقي ومعقول..
خرجت من المثال المرفق بالتصور التالي..
اختر التقرير من مربع التحرير، ومن ثم انقر على معرف العميل لترى البيانات الخاصة بذلك العميل..
إذا نقرت على معرف العميل قبل اختيار التقرير من مربع التحرير تظهر سالة تنبيه..
testreport.accdb
 

وعليكم السلام ورحمه الله وبركاته
أهلا بك.. تفضل
زر خيار.accdb

نسيت أن أخبرك أني بدلت طريقة الإضافة بالنقر المباشر إلى النقر مع ضغط رز التحكم Ctrl .. لأن النقرالمباشر مربك بعض الشيء..
 
قمت بعمل بعض التحسينات منها..
إظهار رقم المخطط في أعلى يمين الصورة، كما يظهر في أعلى النموذج..
عند النقر على النقطة يتم إضافة رقم المخطط ومسى الحي تلقائيا..
Map Pointer.zip

هذه النسخة الأخيرة من التعديل أرجو أن تكون فيها فائدة للجميع..
وأعتذر للجميع بإغلاق المشاركة..
Dashboard2003.mdb

أهلا بك..
أنت بحاجة إلى التحقق من كون الملف موجود قبل إجراء عملية النسخ بهذه الطريقة...
Sub CopyFile() Dim rs As DAO.Recordset Dim fso, sSourceFile, sDestinationFile Set fso = CreateObject("Scripting.FileSystemObject") Set rs = CurrentDb.OpenRecordset("SELECT crn FROM BASIC_DATE") If rs.RecordCount = 0 Then Exit Sub End If  rs.MoveFirst Do Until rs.EOF  sSourceFile = Application.CurrentProject.Path & "\CONTACT\" & rs!crn & ".pdf" sDestinationFile = Application.CurrentProject.Path & "\CONTACT\old\" '-- تحقق من أن الملف موجود قبل إجراء عملية النسخ If fso.FileExists(sSourceFile) Then fso.CopyFile sSourceFile, sDestinationFile, True fso.DeleteFile sSourceFile End If rs.MoveNext    Loop End Sub  

أهلا بك..
نعم.. الشفرة التالية تقوم بالتحديث والإدراج معاً!
Sub UPDATE_FROM_EXCEL() '-- GET EXCEL FILE Dim XL_FILE As String XL_FILE = CurrentProject.Path & "\ITEMX.xlsx" '-- WRITE SQL STATEMENT Dim SQL As String SQL = SQL & "UPDATE TABLE1 AS T1 " SQL = SQL & "RIGHT JOIN " SQL = SQL & "(SELECT * FROM [SHEET1$] IN'" & XL_FILE & "'" SQL = SQL & "[EXCEL 12.0;HDR=YES;IMEX=1;]) AS T2 " SQL = SQL & "ON T1.[كود_الصنف] = T2.[كود الصنف] " SQL = SQL & "SET T1.[كود_الصنف] = T2.[كود الصنف]," SQL = SQL & "T1.[اسم_الصنف] = T2.[اسم الصنف]" '-- RUN SQL STATEMENT CurrentDb.Execute SQL End Sub ITEMX.accdb ITEMX.xlsx

أهلا  @حلبي
عنصر تحكم الصورة في أكسس لا يقبل التركيز ولذا فإن (Screen.ActiveControl) لا يمكن أن يعيد قيمة الخصيصة (Tag) الخاصة بالصورة! 
نحن بحاجة إلى شيء يكون مقبولا مع جميع العناصر.. أجريت التعدل اللازم .
الأصناف.zip
تجربتي يمكن تعجبك!
عند التقر على الصورة، إذا كانت المادة موجودة تزيد الكمية!
PRODUCTS.zip

أهلا بك @ابو البشر
بالنسبة للرقم (1): المنهج GetRows يعيد عدد من صفوف بيانات الجدول المشار إليه في المتغير الغرضي XLRS. والرقم بين القوسين يبين عدد الصفوف المطلوب إعادتها..
المنهج GetRows يعيد مصفوفة بيانات من حدين؛ الحد الأول يمثل رقم عمود البيانات (الحقل) في الجدول والثاني يمثل رقم الصف البيانات (السجل).. هذه الحدود يبدأ ترقيمها بالرقم 0
يجب اسناد المنهج GetRows إلى متغير مصفوفة بيانات عامة غير معينة الحدود.. وهو هنا RCROW؛ وهو المشار إليه بالرقم (2).  وكمثال (0,0)RCROW  يعيد قيمة العمود الأول من الصف  الأول في جدول البيانات.
بالنسبة للرقم (3) :عند تجهال أسماء أعمدة البيانات المستوردة من أكسل يقوم أكسس بوضع أسماء مزيفة تبدأ بـ (F1)؛ و (F) اختصار كلمة Field و(1) رقم عمود البيانات في أكسس..
إذا كانت ورقة البيانات في أكسل تحتوي على أسماء للأعمدة فيمكن تغيير ذلك من خصائص استيراد البيانات؛ إما على مستوى مصنف البيانات أو على مستوى ورقة بيانات محددة...
بالنسبة للرقم (4): يمكن الاستغناء عن المحدد، أو توسيع نطاقه.. لكن لا يمكن استخدام نطاقات متعددة في المجال الواحد..
 
أرجو أن يكون هذا التفسير واضحاً ومفهوماً .. 

السلام عليكم..
أرى أن حواراً ممتعا دار في هذه المشاركة مما أثار رغبتي في المشاركة.. 😀
أرجو أن تجدوا في هذه المشاركة شيئاً جديداً ومميزاً.. 🤩
سوف نتعامل مع مصنف أكسل كقاعدة بيانات  ولعمل ذلك نطبق الشفرة التالي 
'-- OPEN XLS FILE AS REMOTE DATABASE Dim XLDB As DAO.Database Set XLDB = OpenDatabase( _ CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;") عند فتح مصنف أكسل كقاعدة بيانات سوف تصبح أوراق البيانات كجداول بيانات في أكسس، ولكي نتحقق من ذلك نستخدم الغرض TableDefs لسرد أسماء الجداول (أوراق البيانات)
'-- LOOP THROUGH XLDB TABLES (SHEETS) For Each TD In XLDB.TableDefs TD.Name Next :: عند النظر إلى ورقة البيانات في مصنف البانات نجد البيانات محصورة في العمودين (C,I) والبيانات ليست متساوية الطول وبالتالي نحن بحاجة إلى جعل كل عمود جدول بيانات مستقل!
:: يوجد في مكون البيانات Recordset وظيفة اسمه Getrows تقوم بتجميع البيانات كمصفوفة بيانات يحدد طولها المستخدم حسب احتياجة.  ولكون البيانات الطالب في ورقة البيانات تتكون من 5 صفوف؛ وبناءُ عليه سوف نقوم بتجميع البيانات على هذا الأساس. لكن يجب أن نقوم بأخذ عدد السجلات في الجدول (ورقة البيانات) والذي هو بالتأكيد من مضاعفات الـ(5).
الوظيفة Getrows تقوم بأخذ المجموع التالية من السجلات عن اطلاقها مرة أخرى وبالتالي نحن بحاجة إلى دوارة بطول السجلات وتقوم بالقفز كل 5 سجلات، بمعنى (20/5).
:: نقوم بعد ذلك بتسجيل البيانات في جدول الطلاب من مصفوفة البيانات التي تعيدها Getrows.
:: سوف تدور الشفرة على جميع الجداول (أوراق البيانات) وتكرر جلب البيانات مرتين حسب أعمدة البيانات التي سبق الإشارة إليها. كما أنها تقوم بحذف الصفوف الفارغة عند جلب البيانات.
الشفرة التالية توضح المبدأ السابق وطريقة نقل البيانات..
'-- LOOP THROUGH XLDB TABLES (SHEETS) For Each TD In XLDB.TableDefs '-----------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (C) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing '--------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (I) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing Next إليكم الشفرة كاملة
Option Compare Database Option Explicit Sub IMPORT_XLSDB() On Error GoTo SUB_CLOSE '-- OPEN CURRENT DATABASE AS LOCAL DB Dim DB As DAO.Database Set DB = CurrentDb '-- OPEN RS DB TO ADD DATA Dim DBRS As DAO.Recordset Set DBRS = CurrentDb.OpenRecordset("TABLE") '-- OPEN XLS FILE AS REMOTE DATABASE Dim XLDB As DAO.Database Set XLDB = OpenDatabase( _ CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;") '-- OPEN XLS SHEET AS REMOTE RS Dim XLRS As DAO.Recordset Dim RCROW() Dim RC As Long Dim I As Integer Dim TD As DAO.TableDef '-- LOOP THROUGH XLDB TABLES (SHEETS) For Each TD In XLDB.TableDefs '-----------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (C) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing '--------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (I) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing Next SUB_CLOSE: '-- COLOSE XLDB AND XLRS Set XLRS = Nothing ' XLDB.Close Set XLDB = Nothing '------------------------' '-- CLOSE DB AND DBRS Set DBRS = Nothing XLDB.Close Set XLDB = Nothing End Sub  
وهذه هي المفرفقات التى تتضمن المثال...
 
CS_SeetNumberLabels2.xlsxPosters.accdb

أهلا @Abou Hussien
أعتذر إليك لعدم الرد في الوقت المناسب.. 
بالنسبة لتصدير البيانات فيمكنك استخدام معالج البحث في المنتدي لكون هذه الجزئية من السؤال قد سبق الإجابة عنها بطرق مختلفة..
أما ما يتعلق بتحديث وإضافة البيانات فيمكن عمل ذلك بخطوة واحدة عن طريق استعلام التحديث بالطريقة الموضحة بالشفرة أدناة..
-- بما أن كلا القاعدتين لها نفس أسماء الجداول وأسماء الحقول أيضا فنحن بحاجة إلى تمرير اسم قاعدة البيانات فقط.
أعتذر عن عدم شرح الشفرة لضيق الوقت.. لكن يمكنك أن تسأل عن أي جزئية غير مفهومة!
Sub UPDATE_BILL_HEAD_TBL(DATA_SOURCE As String) CurrentDb.Execute _ "UPDATE BILL AS P RIGHT JOIN [" & DATA_SOURCE & "].BILL AS F " _ & "ON (P.BILL_NUM=F.BILL_NUM) " _ & "SET P.BILL_NUM=F.BILL_NUM, P.BILL_DATE=F.BILL_DATE, " _ & "P.CLIENT_NAME=F.CLIENT_NAME, P.PAID=F.PAID, P.DETAILS=F.DETAILS" End Sub Sub UPDATE_BILL_DETAIL_TBL(DATA_SOURCE As String) CurrentDb.Execute _ "UPDATE BILL_DETAIL AS P RIGHT JOIN [" & DATA_SOURCE & "].BILL_DETAIL AS F " _ & "ON (P.BILL_NUM=F.BILL_NUM) AND (P.ITEM_NUM=F.ITEM_NUM) " _ & "SET P.BILL_NUM=F.BILL_NUM, P.ITEM_NUM=F.ITEM_NUM, P.PRICE=F.PRICE" End Sub المرفقة يوضح آلية التحديث والإضافة: 
Uptate Data Example.zip

أهلا  @عبق الرياحيين
 بدلي هذا السطر
listBoxWorksheets.RowSource = objWsh.Name بهذا
listBoxWorksheets.AddItem objWsh.Name  
Import Excel.zip

أهلا ناقل..
يمكن العثور على معلومات وافية مع المثال عن هذه الخاصية في تعليمات أكسس على الرابط التالي..
Recordset.Bookmark property .. DAO
والمصورات التالية ترجمة فنية للمقال من كتاب دليل اللغة Visual Basic مع المقدمة الملهمة..

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

 
.. قم بتغيير وظيفة معالجة الصور لتصبح كالتالي
Public Function FileName(ImagName) Dim ImgPath As String ImgPath = CurrentDb.QueryDefs("WorkerSubQ").Properties("Description") FileName = Dir(ImgPath & ImagName & ".*") If FileName = "" Then FileName = ImgPath & "No.jpg" Else FileName = ImgPath & FileName End If End Function  
.. عند نقل مجلد الصور إلى مكان آخر.. قم بتغييره في خانة الوصف للاستعلام فقط..
 
Worker.accdb
 
 

أهلا @محمد احمد لطفى
جمعت لك البيانات كلها في وضيفة واحدة وسميتها ()Cons0819 
الأرقام في اسم الوظيفة يدل على الشهر والسنة
للوظيفة ثلاث محددات: تاريخ الاستهلاك، وكمية الاستهلاك، ودليل البيانات الراجعة
كتبت في الوظيفة تفسيرا لقيمة البيانات الراجعة
قمت بوضع بعض القيمة الراجعة من الوظيفة بجوار نظيرها في الاستعلام  من أجل إجراء مقارنة سريعة للتأكد صحة البيانات
المهم أن الوظيفة ينقصها بعض المراجعة والضبط مع متطلباتك.. أرجو التكرم بالمراجعة.. 
إليك التعديل: كهرباء 2019.mdb

أهلا بك @ازهر عبد العزيز
حتى ينتهي @ابا جودى و @Khalf من العتاب إليك الطريقة
في عرض التصميم للنموذج.. حدد زر الأمر المطلوب؛ ومن التبويب أخري.. غير قيمة افتراضي إلى نعم!

استخدم الصيغة التالية
Call Shell("XCOPY /Y E:\MAF\PQD_BE.accdb C:\Users\" & Environ ("UserName") &"\Dropbox\", 1)  

أهلا بك أبو زاهر..
لم استطع فهم آلية إدراج الأصناف في الفاتورة.. لكن إن كان الموضوع يتعلق بما أشرت إليه من تسبب المنهج (Me.Recalc) في تعطل الإضافة؛ فقد تراجعت عنها واستخدم  الأسلوب الشرطي فقط..
تشابك التلوين بين السجلان_.zip
 

وعليكم السلام ورحمه الله وبركاته..
عملت نموذجين آخرين بطريقة مختلفة بعض الشئ
إليك التعديل: تشابك التلوين بين السجلان_.zip

والسلام عليكم ورحمه الله وبركاته..
إليك التعديل: السجلات_.zip

وعليكم السلام ورحمة الله وبركاته
أهلا بك علي..
إذهب إلى مكتبة المراجع واخثر المكتبة الموضحة في الصورة
 
أضف الشفرة التالية إلى وحدة نمطية عامة
Function GetFilePath() Dim FDlg As FileDialog Set FDlg = FileDialog(msoFileDialogFilePicker) FDlg.Title = "Select Picture File" FDlg.Filters.Clear FDlg.Filters.Add "Pictures", "*.Png,*.Jpg,*.Bmp,*.Tiff,*.Gif" FDlg.Filters.Add "All Files", "*.*" FDlg.AllowMultiSelect = False If FDlg.Show Then GetFilePath = FDlg.SelectedItems(1) Debug.Print GetFilePath End If End Function استبدل السطر التالي
picturepaht = GetOpenFile_CLT("", "ÇÎÊÑ ÕæÑÉ :") بالسطر هذا
picturepaht = GetFilePath()  

وعليكم السلام ورحمة الله
عملت لك إجرائين..
إجراء لحفظ مرفقات السجل الحالي 
إجراء لحفظ جميع المرفقات في الجدول
إذا كان حقل المرفقات يحمل أكثر من مرفق فسيقوم الإجراء بإضافة رقم تسلسلي لاسم الصورة بغض النظر عن نوع المرفق
 
إليك المرفق: Save Attachment File.zip

جرب على الهوية رقم 111
إليك التعديل:mailk.zip

وعليكم السلام ورحمة الله وبركاته @محمد احمد لطفى
إليك التعديل test200.zip

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

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

في التقرير قم بإضافة مرجع رقم الموظف إلى مصدر بيانات التقرير بعد قلبه إلى استعلام كما في الصورة التالية

 
الطريقة الثانية في نظري لا تلزمك
إليك التعديل
Save with record no.zip

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

وهذا المثال بعد التعديل
كهرباء.zip