qathi

ننتظر أستاذنا الغالي حسنين @SEMO.Pa3x بارك الله فيك على كل ماتقدمه لنا

قمت بتجربة الملف بشكل بشكل سريع أخي أحمد @احمد الفلاحجي ,, ماذا عساي أن أقول لك ؟ سوى أن أدعوا لك (( أسأل الله أن يبشرك ويبشر والديك وذريتك بالجنة الفردوس الأعلى ,, وأن يرزقك السعادة الذي ترجوها من الله يوم أن تلقاه .. وأن يسعدك في الدنياء والأخرة )) .. كما أسعدتني بارك الله فيك .. وشكرا على مجهودك الرائع

اين اساتذتنا الافاضل ولا أرى رداً لهم

السلام عليكم اساتذتنا الاكارم واخواني أعضاء المنتدى الرائع أسأل الله أن تكونوا جميعاً في أتم الصحة والعافية طلب تعديل كود الاستعلام VBA --------------- عمل الكود: الكود يقوم بالتالي يقوم الحاق حقول من استعلام ItemsCopy_Qr الى جدول BarcodeItems_T مع تكرار السجلات حسب رقم حقل QuantityS الموجود في الاستعلام الاول ItemsCopy_Qr في كل سجل المطلوب: تعديل كود الاستعلام بحيث لا يقوم بالحاق وتكرار السجلات ألا بشرطين هما : 1- الشرط الاول : السجلات التي تحتوي رقم الحقل InvoiceNum في استعلام ItemsCopy_Qr يساوي نفس الموجود في حقل القائمة المنسدلة K1 بالنموذج Run_F كالكود التالي: WHERE (((ItemsCopy_Qr.InvoiceNum)=[Forms]![Run_F]![K1])) 2- الشرط الثاني : السجلات الذي يكون حقل sisl مؤشر علية الصح , كالكود التالي: ((ItemsCopy_Qr.sisl)=1) أو ((ItemsCopy_Qr.sisl)=True) --------------- 'On Error Resume Next Const RTableName As String = "ItemsCopy_Qr" Const ALLItemsTableName As String = "BarcodeItems_T" Dim stmailList As String Dim MyDB As Database Dim r As Recordset Set MyDB = CurrentDb Dim SqlSt As String Dim ItemCounter, RRecordCounter, count As Integer Set r = MyDB.OpenRecordset(RTableName) r.MoveFirst Do r.MoveNext Loop Until r.EOF DoCmd.SetWarnings False SqlSt = " DELETE " & ALLItemsTableName & ".* FROM " & ALLItemsTableName & " ; " DoCmd.RunSQL (SqlSt) For RRecordCounter = 1 To r.RecordCount r.MoveFirst r.Move RRecordCounter - 1 For ItemCounter = 1 To r.Fields("QuantityS") SqlSt = "INSERT INTO " & ALLItemsTableName & " (BarCodeNumber,PriceS,ItemName,curName,CuCodn,CodeCounter) VALUES ( """ & r.Fields("BarcodeReader") & """,""" & r.Fields("PriceS") & """,""" & r.Fields("ItemName") & """,""" & r.Fields("currNames") & """,""" & r.Fields("CuCode") & """," & ItemCounter & " );" DoCmd.RunSQL (SqlSt) Next ItemCounter Next RRecordCounter DoCmd.SetWarnings True r.Close Set r = Nothing Set MyDB = Nothing --------------- شاكرا لكم على ماتقدموه من جهد ووقت لنا .. فجزاكم الله عنا خيرا ملاحظة/ - تنفيذ الامر من خلال زر في نموذج Run - الكود موجود في موديول BarcodePrintGroup_M - يتم فك ضغط الملف المرفق في القرص D mm.rar

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

هناك مواقع كثير متخصصة في جمع مثل هذه الأصوات .. يكفي أن تقوم بالبحث عنها في محرك البحث جوجل مثال أصوات الويندوز 7 أو 10 وستجد فيها الذي تريد

بارك الله فيك استاذنا ابوجودي روعة جدا وكنا نتمنى وجدة من زمان لكن هذا مايعهد منك الابداع والتألق جزاك الله عنا خيرا

بارك الله فيك استاذنا

استاذي الغالي @ابو جودي .. هل ينفع الليلة لحل هذا الاشكال اون لاين .. منتظر منك رد .

شكرا لك استاذنا القدير @SEMO.Pa3x

مبارك عليك الترقيه .. ما شاء الله .. بالتوفيق لك

عمل جميل .. بارك الله فيك

استاذي الغالي @jjafferr .. شكرا لك .. تم بنجاح مع العلم .. لا يتم وصول رساله الى البريد نهائياً لاعادة تعيين وجربت اكثر من مرة

وهو كذلك ان شاء الله

بعد أذن استاذنا الغالي حسنين .. أن سمح لي ملاحظة بسيطة للمبتدئين : كحالتنا: تغيير بدل CurrentProject.Path الى مسار حفظ الصورة مثال: "D:\Image" مع كتابة علامة ""

أهلا باستاذي الغالي @ابو جودي .. اشتقنالك .. اعتذر عن غيابي .. لأنشغالي .. لكن لا بد من عودة نتلمس احوالك اساتذتي ورفاق المنتدى الرائعيين جرت ولم تنفع .. أرجو ان تقوم بالتجربة في اوفس 2016 عربي نوع 32 بت >> Office Professional Plus 2016 32bit Ar

ساكون ان شاء الله بانتظار ذلك استاذنا الغالي حسنين

استاذنا الغالي حسنين @SEMO.Pa3x هل بالامكان أرفاق صورة مع الرسالة ؟؟

بارك الله في استاذنا حسنين @SEMO.Pa3x ننتظر منك التحديث الجديد

تعقيب .. هذه الطريقة تنفع في ويندوز 7 .. لكن للاسف لا تنفع في ويندوز 10 و 11 هل يوجد حل لعرض الايقونة في شريط المهام في ويندوز 11 وكذلك 10 مع ملاحظة اختلاف الاعدادات في كلاء الاصدارين للويندوز ؟؟؟

تم حل المشكلة قمت بتعديل الكود ونجح الامر وضعت الحل هنا حتى يستفاد غيري Private Sub R3_Click() If MsgBox("åá ÊÑíÏ ÇÌÑÇÁ äÓÎÉ ÇÍÊíÇØíÉ ãä ÇáÈÑäÇãÌ¿", _ vbQuestion + vbYesNo, _ "äÓÎÉ ÇÍÊíÇØíÉ") = vbYes Then On Error Resume Next Dim fileName As String fileName = GetDesktop & "\" & "Backup" & "" ' fileName = GetDesktop Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB Dim fs, cf, strFolder ' strFolder = CurrentProject.Path & "\Backup" strFolder = fileName Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then Set cf = fs.CreateFolder(strFolder) End If ' OldFile = CurrentDb.Name OldFile = CurrentProject.Path & "\DataBe\Data.DB" ' مسار حفظ النسخة ' StrNew = CurrentProject.Path & "\Backup" StrNew = fileName DBwithEXT = Dir(OldFile) DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6) If [BKUP] = True Then NewFile = StrNew & "\" & DBwithoutEXT & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & Right(DBwithEXT, 6) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 Exit Sub End If End If End Sub 'هذه الدالة تستخرج مسار سطح المكتب لديك Function GetDesktop() As String Dim oWSHShell As Object Set oWSHShell = CreateObject("WScript.Shell") GetDesktop = oWSHShell.SpecialFolders("Desktop") Set oWSHShell = Nothing End Function الكود يقوم بعمل نسخة في سطح المكتب داخل مجلد Backup توجد مشكلة بسيطه وهي: اذا كان عدد حروف اسم القاعدة الخالفية اكبر من سته احرف فانه يقتطع مابعد 6 ويضع الفرمات التاريخ والوقت ويكمل بقية الاحرف بعد ذلك فياريت اجد حل يضع اسم القاعدة كما هو .. وبعد ذلك فرمات التاريخ والوقت وبعد ذلك الامتداد الكود المسؤل عن هذا التالي: NewFile = StrNew & "\" & DBwithoutEXT & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & Right(DBwithEXT, 6) شاكرا لكل من ساهم و رد على الموضوع

وعليكم السلام أخي @محمد أبوعبدالله شكرا على ردك ومرورك الطيب اذا كنت ساعتمد على طريقتك اخي أذاً أستسمحك أن نناقش نقاط طريقتك - بالنسبة النقطة الاولى الذي تحدثت عنها فجيد تم التجربة نوعاً ما وليس كلياً بخصوص تطبيق جوجل - اما بالنسبة النقطة الثاني وهو الكود الخاص بعمل نسخة احتياطية .. فان فيه مشكلة وهو انه يقوم بعمل نسخة احتياطية للقاعدة الواجهه وليس الخلفية طبعا لا أخفيك أني حاولت مرارا ضبط الكود .. حتى يتم حفظ نسخه الى داخل مجلد بسطح المكتب لكن دون جدوى وقد اعتمدت على كود استدعاء مسار سطح المكتب الموجودة بالمنتدى 'هذه الدالة تستخرج مسار سطح المكتب لديك Function GetDesktop() As String Dim oWSHShell As Object Set oWSHShell = CreateObject("WScript.Shell") GetDesktop = oWSHShell.SpecialFolders("Desktop") Set oWSHShell = Nothing End Function والمطلوب عمل نسخة احتياطية للقاعدة الخلفية بنفس اسم القاعدة وبتاريخ ووقت الحالي الى داخل مجلد سطح المكتب علما ان مسار القاعة الخلفية مع التنسيق كالتالي : \DataBe\DataQa.DB شاكرا لك تعاونك والجهد الذي تبذله

اخوني واساتذتي الافاضل حياكم الله وبعد بما انه لم يتم الوصول حل للطلب في الموضوع السابق قمت بعمل ملف يوضح بشكل افضل لما هو مطلوب مرفق الملف Database1.accdb

للرفع للاهمية ...

هل جربت الكود الذي وضعت في الرد السابق ؟؟