نجوم المشاركات

اعتقد يقصد الـتسمية " Caption " والحل فى وحدة نمطية عامة Public Function CopyCaptionToTextBox(TextBoxName As String) Dim ctrl As Control Set ctrl = Screen.ActiveControl If TypeOf ctrl Is CommandButton Then Forms(ctrl.Parent.Name).Controls(TextBoxName).Value = ctrl.Caption End If End Function للاستدعاء على اكثر من زر اولا تحديد كل الازرار التى نريد منها تنفيذ هذا الاجراء والاستدعاء يتم بكتابة الكود بالشكل التالى فى الحدث عند الضغط طبعا مع تغيير YouTextBoxNameInForm باسم مربع النص الموجود فى النموذج =CopyCaptionToTextBox("YouTextBoxNameInForm") المرفق بعد التعديل RR.accdb

احيانا الاعتماد على التاريخ للترقيم يسبب بعض المشكلات لذا تم تحويل التاريخ الى رقم من اجل زيادة ضبط المعادلة Database1 (1).rar

::بسم الله نبدأ:: السلام عليكم ورحمة الله وبركاته اخوتي الكرام كل عام وانتم بخير اليوم وكما هو موضع من عنوان الموضوع موضوعنا عن ربط برنامج الاكسيس بصفحات الويب وهنا اخص لغة ال PHP كان فى سائل عن امكانية ربط برنامج الاكسيس بالنت علشان يسمح للمرضي بتحميل التقارير الخاصه بهم ورديت عليه تقريبا ان الموضوع صعب لكن اليوم اقدم لكم طريقه اتمني ان تكون سهله وواضحه واعذروني على المقدمة الطويله ورقاقة الكلمات نبدأ اولا بالادوات الازم توفرها:- 1- XAMPP يمكن تحميله من هنا 2- Connector/ODBC MYSQL يمكن تحميله من هنا ويفضل تنزيل النسخه 8.0.31 انا عن نفسي شغال بالاصدار 8.0.31 (وشغال تمام) وممكن تحمله من هنا للنسخه 32بت ومن هنا للنسخه 64بت 3- ActiveX WebBrowser control (antview) يمكن تحميل هذه الاداة من هنا او رابط مباشرة من هنا 4- PHP File's & Access File هنا يمكن تحميل الملفات التى قمت بالعمل عليها :: نبدأ بتسطيب برنامج XAMPP :: وهو المحاكي الذى سيعمل فيه بيئة ملفات ال php طبعا المفترض ان هناك دومين موجود بالفعل واستضافة والذى سيتم تنصيب الخدمه عليه وعن طريقها سيكون متاح للمريض ان يحمل تقريره لكن الموضوع هنا للتعليم فنبدأ اولا بتسطيب البرنامج ليس بالامر الصعب بل سهل جدا وحتى لا يطول الشرح اذا واجهتك مشكلة فى تسطيب البرنامج يمكن كتابة وصور المشكله او البحث فى اليوتيوب وهتلاقى الحل المناسب (لكن عموما كل ال هتعمله اوافق والتالى التالى شكرا) بعد تنصيب البرنامج وهذه واجهته ويجب يكونو هكذا هنضغط على مفتاح Explorer او نذهب الى المسار هذا C:\xampp او حسب المكان الذى سطبت البرنامج فيه هندخل على المجلد htdocs وهنا هننسخ مشروعنا ويفضل متلعبش فى الملفات التى داخل المجلد htdocs غير لو انت فاهم بتعمل ايه نرجع لموضوعنا هننسخ الملف ال اسمه LAB وهنضعه فى المجلد htdocs هنفتح المتصفح وندخل على الرابط التالى http://localhost/phpmyadmin/ وهنبدأ بانشاء قاعدة بيانات جديده وهنسميها db_lab بعدها هندخل على القاعدة التى تم انشاءها وهنعمل عمليت استيراد هنضغط على استعراض وهنروح للمسار C:\xampp\htdocs\LAB هنلاقى فى ملف نفس اسم قاعدة البيانات وبعدها هننزل تحت وهنضغط على import وبهذا نكون قد انتهينا من رفع القاعدة نذهب الى هذا الرابط ونتحقق ان كل شئ تمام http://localhost/lab/ لو ظهر لك هذا الشاشة يبقي امورك فى التمام والحمد لله اذا لا بيكون فى خطأ حصل نبدأ نسطب برنامج Connector/ODBC MYSQL (( لا يحتاج الى شرح الامر بسيط وسهل وايضا حتى لا يطول الموضوع )) من هنا هنحتاج الى تركيز الامور بسيطه لكن لازم تتعمل صح هنروح للكنترول بنل لو انت شغال على وندوز 11 لو انت شغال على وندوز 10 هنا هتختار واحد منهم حسب اصدار الاوفيس عندك 32بت ولا 64 بتحميل انا هنا اصدار 64 بت هنكتب الاعدادات كما فى الصورة بالظبط لو انت حاطط كلمة سر لل phpmyadmin هتحطها وتضغط اوك بعد ما تختار القاعده الخاصه بك وبكده نكون انتهينا من هذا الجذء نبدأ تثبيت برنامج ActiveX WebBrowser control (antview) وده ال هيكون مسؤول عن استعراض صفحات الويب داخل الاكسيس وهي اداة ممتاذه عيبه تقريبا حسب الموقع انها مش مجانيه لو فى اى احد عنده طريقة نستخدم خاصية webview2 هي موجوده فى اوفيس 365 تقريبا وحسب ما سمعت انها بتنزل متضمنه لكن فى الاصدارات ال معانا مش موجوده او اى اداة اخري تكون مجانيه 100% يبقي تمام تثبيت البرنامج لا يحتاج شرح ^_^ نرجع لملف التطبيق الاكسيس ^_^ ونفتح البرنامج عادي بعد ما تم تثبيت كل الادوات السابق ذكرها وبرنامج الاكسيس هتلاقيه فى مجلد اسمه APP ممكن تنقله لاى مكان عادي وللعلم تم اضافة مكتبة واكود QR Code اخذتها من موضوع استاذى الاستاذ @ابو جودي فى موضوع الفاتورة الالكترونية 🤲 ربنا يبارك فيه وفى جميع اساتذتى هنا 🤲 نفتح ملف الاكسيس ونتأكد ان جميع المكتبات تعمل وليس هناك اى مكتبه مفقوده نركز على الصوره التالية هنتحقق من التالى ان الجداول متصله والمطلوب انك تفتح اى جدول للتأكد انه يعمل الاتصال جيدا هنفتح النماذج اول نموذج معانا FrmGenerator_User هنا انت لو عاوز تعمل اسم مستخدم وكلمة مرور ال هيدخل بيها المريض عندك كما هو موضح من الصورة حلين اما الاكسيس يعمل اسم مستخدم وكلمة سر عشوائية (1) او انت تعمل للمريض اسم مستخدم وكلمة سر يديوية (2) بعد ما تضيف حساب المريض هيكون هنا عندك القدرة على اضافة التقارير للمريض تابع الصور التالية يمكنك تحديد اكثر من ملف هنا فى الكود يسمح لك باستعراض ملفات الصور وال pdf بعد رفعها لو هناك اى ملاحظات تريد ان تسجلها يمكن هذا هتكتب الملاحظه وتعمل حفظ 😁 التالى لو انت عاوز تحول كلمة سر الى كود هاش هذا لو فرضا انك عاوز تغير كلمة السر لحساب ما وللعلم التشفير فى نظام ال PHP تشفير بالهاش هو تشفير فى اتجاه واحد يعنى يمكن عمل مطابقة لكلمة السر مع الهاش لكن متقدرش تحول الهاش الى كلمة سر طبعا ده علشان الحماية وده سياسة التشفير فى PHP والله اعلم او لو عاوز تتحقق من كلمة السر (يعني معاك كلمة السر والهاش وعاوز تتحقق انهم مطابقين ) هتضغط على التحقق وهو هيتحققلك بعد ما تم اضافة حساب للمريض عن طريق نموذج انشاء الحسابات وتم رفع الملفات للمريض هنروح على نموذج انشاء ال QR Code هنختار اسم حساب المريض من القائمة (قائمة المرضي) ونضغط على تصدير رمز ال QR اعتقد اني شرحت كل الامور واذا كان هناك اى مشكلة اقدر احلها لا تتردد فى الاستفسار وهتلاقى الجميع هنا بيسعدك بعض الملاحظات الواجب التنبيه لها يجب ان تغير عنوان الموقع اما للدومين اذا كان لديك دومين مع تعديل مسار البرنامج اذا لزم الام او كتابة عنوان الكمبيوتر الخاص بك اذا كنت تريد التجربه علشان لما تقراء كود QR يدخلك على الصفحه بطريقة صحيحة طريقة التعديل :- هتروح على كود نموذج انشاء كود QR وتعدل على العنوان بدل 127.0.0.1 وكل عام وانتم بخير وختاما نسألكم الدعاء لوالدتي الله يرحمها والشفاء لوالدي ربنا يبارك فى صحته ولا تنسونا من صالح دعواتكم الطيبة

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

شكر وتقدير واحترام من اخيك

تمام وصلت الفكرة جزاك الله خيرا وانار طريقك

السلام عليكميكفي تغيير المعادلة في الخلية C26 في شيت Dashboard والتي هي : E22&""= بالمعادلة : E22= كما في الملف المرفق... بيان الربح والخسارة_Copy (3).xlsx

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

وعليك يا باش مهندس ^_^ ويشرفنى مروركم الكريم 🌹 اللهم امين يا رب العالمين الفكريه مبنيه على ازاى اجعل المريض يقدر يحمل تقريره اون لاين فكان ولا بد من وجود وسيط يمكن نقل التقرير عن طريقه من الاكسيس (المعمل) الى المريض وانشاء بيئة العمل للموقع اجبارى اولا لانك كيف يمكن الربط مع mysql وليس هناك بيئة العمل للسيكول ولغة php فلذا قمت بعمل تصميم بسيط واستعنت فيه بالذكاء الصناعي علشان انجز بعض المعطيات كان ممكن تاخد منى وقت اذا اردت عملها بنفسي فخلفيتى فى لغة ال php ليس كبيره لكن تمكنني من فهم الادوات التى تحت ايدي لهذا قمت ببرمجة كام صفحه للغرض المطلوب مع الاستعانه بصفحة الدخول جاهزه مع التعديل عليها بما يتناسب مع المطلوب منها واذا كان هناك شئ غير مفهوم او انا لم اجب على استفسارك بالمطلوب يا ريت توضح لى

استاذى والمعلم (بضم الميم) الكبير المهندس / محمد عصام فكرة جميلة ورائعة كما تعودنا منك اخراج الروائع وانا فى انتظار تعديل الشرح تفصيلا جزاك الله كل خير ورزقلك وبارك الله فى علمك

انا عملت لك المطلوب ولكن عكست الخط ترحل اول ثم تعرض خانة الاختيار وضعت لها شرط ولكني لم اقم بتفعيلها في الاستعلام .. يمكنك عملها ان احببت جرب فقد تروق لك الطريقة TransBom3.rar

جرب هدا Sub Print_Tbl() Dim lr As Long Set WS = Sheets("ELRASHIDY") Application.ScreenUpdating = False With WS .ResetAllPageBreaks lr = WS.Columns("B:X").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Application.PrintCommunication = False With WS.PageSetup .PrintArea = WS.Range("B2:X" & lr).Address .FitToPagesWide = 1 .FitToPagesTall = 1 End With End With Application.PrintCommunication = True Application.ScreenUpdating = True ActiveWindow.SelectedSheets.PrintPreview 'WS.PrintOut Copies:=1 End Sub اخي لقد حاولت حدف الاعمدة الغير مستخدمة مما سيجبرني على تعديل الكود السابق بما يناسب التصمييم الجديد Sub my_date() Dim xDate As String, i As Long Set sh = Sheets("ELRASHIDY") Do xDate = InputBox("insert date format month/year ", "insert month date", "MM/YYYY") If StrPtr(xDate) = 0 Then Exit Sub If xDate = "MM/YYYY" Then MsgBox "يرجى ٌإدخال التاريخ", 48 Loop While xDate = "MM/YYYY" If Not IsDate(xDate) Or Not (xDate) Like "##/####" Then _ MsgBox "يرجى التحقق من التاريخ", 16: Exit Sub Application.ScreenUpdating = False With sh .Range("A6:B36,I6:J36").ClearContents cnt = DateSerial(Year(xDate), Month(xDate), 1) arr = Array("A6", "I6", "G4", "O4") tmp = DateSerial(Year(xDate), _ Month(xDate) + 1, 1) - cnt For i = LBound(arr) To UBound(arr) .Range(arr(i)).Value = cnt Next i [A6].AutoFill Destination:=[A6].Resize(tmp), Type:=xlFillDays [I6].AutoFill Destination:=[I6].Resize(tmp), Type:=xlFillDays For i = 6 To sh.Cells(Rows.Count, "A").End(xlUp).Row ColDates = Range("A" & i).Value DayName = Format(ColDates, "dddd") With Union(sh.Range("B" & i), sh.Range("J" & i)) .Value = DayName End With Next i End With Application.ScreenUpdating = True End Sub Sub PrintTb2() Dim lr As Long Set WS = Sheets("ELRASHIDY") With WS .ResetAllPageBreaks lr = .Cells(.Rows.Count, "a").End(xlUp).Row Application.PrintCommunication = False With WS.PageSetup .PrintArea = WS.Range("A2:O" & lr).Address .FitToPagesWide = 1 .FitToPagesTall = 1 End With Application.PrintCommunication = True WS.PrintPreview 'WS.PrintOut Copies:=1 End With End Sub SHADY TIME TABLE 1_V4.xls

تم ايجاد المشكلة بحمدلله الخاص بتعديل الكمية وارجاعها للمخزنين سواء خصم اوزيادة فى احداهما يوجد كودين Private Sub CommandButton2_Click() ' ... rest of your code ... Dim wsSales As Worksheet, wsStock As Worksheet Dim lastRowSales As Long, lastRowStock As Long Dim i As Long, j As Long Dim invoiceNo As Long, fromStore As String, toStore As String, itemCode As String, quantity As Long, newQuantity As Long Dim quantityDiff As Long 'رقم الفاتورة invoiceNo = Val(TextBox2.Value) ' ComboBox1 المخزون الاول fromStore = ComboBox1.Value ' ComboBox2 المخزون الثانى toStore = ComboBox2.Value ' ComboBox1 رصيد المخزون الاول fromStore1 = stocktr.Value ' ComboBox2 رصيد المخزون الثانى toStore2 = stocktrr.Value 'شيت مبيعات Set wsSales = Worksheets("Transferts") 'شيت المخزون Set wsStock = Worksheets("Inventaire") 'ابحث عن الفاتورة في ورقة المبيعات lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRowSales If wsSales.Cells(i, "A").Value = invoiceNo Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) ' احسب فرق الكمية quantity = wsSales.Cells(i, "H").Value quantityDiff = newQuantity + quantity ' قم بتحديث الكمية في ورقة المبيعات wsSales.Cells(i, "H").Value = newQuantity wsSales.Cells(i, "k").Value = Now() ' تاريخ التعديل wsSales.Cells(i, "l").Value = Environ("Username") ' اسم المستخدم End If Next i ' ابحث عن الفاتورة في ورقة المخزون lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "A").Value = fromStore Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) quantity = wsStock.Cells(j, "D").Value quantityDiff = newQuantity - quantity ' قم بتحديث الكمية في ورقة المبيعات wsStock.Cells(j, "D").Value = newQuantity + fromStore1 ' تحديث الكميات في المخزون ' ... (نفس الكود السابق لإرجاع الكميات) ElseIf wsStock.Cells(j, "A").Value = toStore Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) ' احسب فرق الكمية quantity = wsStock.Cells(j, "D").Value quantityDiff = newQuantity + quantity ' قم بتحديث الكمية في ورقة المبيعات wsStock.Cells(j, "D").Value = toStore2 - newQuantity wsStock.Cells(j, "J").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "K").Value = Environ("Username") ' اسم المستخدم End If Next j MsgBox "تم تعديل الفاتورة وإرجاع الكميات بنجاح" End Sub Private Sub CommandButton2_Click() Dim wsSales As Worksheet, wsStock As Worksheet Dim lastRowSales As Long, lastRowStock As Long Dim i As Long, j As Long Dim invoiceNo As Long, fromStore As String, toStore As String, itemCode As String, quantity As Long, newQuantity As Long Dim quantityDiff As Long invoiceNo = Val(TextBox2.Value) ' ComboBox1 المخزون الاول fromStore = ComboBox1.Value ' ComboBox1 المخزون الاول toStore = ComboBox2.Value ' ComboBox1 قيمة المخزون الاول fromStore1 = stocktr.Value ' ComboBox2 قيمة المخزون الثانى toStore2 = stocktrr.Value Set wsSales = Worksheets("Transferts") Set wsStock = Worksheets("Inventaire") lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRowSales If wsSales.Cells(i, "A").Value = invoiceNo Then newQuantity = Val(TextBox1.Value) quantity = wsSales.Cells(i, "H").Value quantityDiff = newQuantity + quantity wsSales.Cells(i, "H").Value = newQuantity wsSales.Cells(i, "k").Value = Now() ' تاريخ التعديل wsSales.Cells(i, "l").Value = Environ("Username") ' اسم المستخدم End If Next i lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock quantity = wsStock.Cells(j, "D").Value If wsStock.Cells(j, "A").Value = fromStore Then wsStock.Cells(j, "D").Value = newQuantity + fromStore1 ElseIf wsStock.Cells(j, "A").Value = toStore Then wsStock.Cells(j, "D").Value = toStore2 - newQuantity ' تم التعديل هنا wsStock.Cells(j, "J").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "K").Value = Environ("Username") ' اسم المستخدم End If Next j MsgBox "تم تعديل الفاتورة وإرجاع الكميات بنجاح" End Sub امين مخزن4.xlsm

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

وعليكم السلام ورحمة الله تعالى وبركاته رغم انه في وجهة نظري ان الاقتراح المقدم من اخينا @AbuuAhmed افضل واسهل وينفد المطلوب دون الحاجة لاستخدام صندوق الادخال في حالة كانت لك رغبة لاستخدام نفس الطريقة يمكنك تجربة هدا Sub my_date() Dim xDate As String, i As Long Set sh = Sheets("ELRASHIDY") xDate = InputBox("insert date format month/year ", "insert month date", "MM/YYYY") If StrPtr(xDate) = 0 Then Exit Sub If Not IsDate(xDate) Or Not (xDate) Like "##/####" Then _ MsgBox "يرجى التحقق من تاريخ الادخال", vbExclamation: Exit Sub Application.ScreenUpdating = False With sh .Range("B6:C36,N6:O36").ClearContents tmp = DateSerial(Year(xDate), _ Month(xDate) + 1, 1) - DateSerial(Year(xDate), Month(xDate), 1) Range("B6,N6,I4").Value = DateSerial(Year(xDate), Month(xDate), 1) [B6].AutoFill Destination:=[B6].Resize(tmp), Type:=xlFillDays [N6].AutoFill Destination:=[N6].Resize(tmp), Type:=xlFillDays For i = 6 To sh.Cells(Rows.Count, "b").End(xlUp).row ColDates = Range("b" & i).Value DayName = Format(ColDates, "dddd") With Union(sh.Range("C" & i), sh.Range("O" & i)) .Value = DayName End With Next i End With Application.ScreenUpdating = True End Sub SHADY TIME TABLE 1_V2.xls

ارجو ان يكون المطلوب TEST.xlsm

السلام عليكم المشكله انك حاطط المعادله داخل جدول خد نسخه من المعادله فى اي مكان بعيد عن الجدول وهيا تشتغل TEST.xlsm

مظبوط أنا عايزة زي ملف الاكسيل دة مجرد اختار الشهر فيتغير بكل ايام الشهر واطبع التقرير SHADY TIME TABLE 1_V4.xls