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

السلام عليكم ورحمة الله وبركاته بعد إذن أساتذتي الكرام ، بعد الاطلاع على ملف الأخ @Elsayeh فإنني أقترح عليه نقل ملحقات الاسم (المرحلة - الشعبة) إلى جواره كي لا تتكرر أو تجمع بعدد مرات تكرار الاسم ، كما أنني لاحظت أنه زاد مواد أخرى فهو قد يكون بحاجة لتعديل الملف على الشكل التالي: وتعديل كود أستاذنا الكريم @lionheart ليتوافق مع طلبه، عذراً على التدخل ولكن أحببت أن أذكر وجهة نظري... والسلام عليكم ترحيل بيانات الاسماء المكررة.xlsm

@lionheart after you نظرة سريعة على الكود جرب تغيير هذا السطر من For ii = 2 To UBound(a, 2) الى For ii = 2 To UBound(a, 2)-2 اذا لم ينجح اصدر موضوع جديد ملاحظة : كما قال لك @lionheart قم بتعديل المسافات للاسماء المتكررة حتى يعمل الكود حتى لا تاتي بعد فترة وتقول الكود لم يعد يعمل تحياتي

وعليكم السلام ورحمة الله 🙂 اهلا وسهلا بك في المنتدى ، وللاستفادة القصوى من المنتدى ، رجاء مراجعة قوانين المنتدى: اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة بما انك طالب ، اذن خليني اشرح لك ، وانت تعمل الباقي للحصول على النتيجة ادناه 🙂 . 1. اعمل استعلام خاص للنموذج الذي على اليسار ، ولنحفظه باسم qry_Left ، واجعل هذا مصدر بيانات النموذج الذي على اليسار ، 2. اعمل استعلام خاص للنموذج الذي على اليمين ، ولنحفظه باسم qry_Right ، واجعل هذا مصدر بيانات النموذج الذي على اليمين ، 3. في الاستعلام qry_Right ، في معيار الحقل Employee_Name ، سنكتب (لا يوجد Not In) اننا لا نريد الاسماء من الاستعلام qry_Left ، وهذا هو المعيار: not in(Select Employee_Name From qry_Left) 4. اغلق كل شيء ، وافتح من جديد ، وسترى النتيجة اعلاه 🙂 جعفر

متابع بعد 14 سنة من تاريخ الموضوع 😁

ما يخطر ببالي هو أنا السجل الحالي غير محفوظ بعد ( Not Saved ) . الأفضل أن ترفق مثال (مرفق) ليتضح الأمر .

السلام عليكم ورحمة الله وبركاته التطبيق اهداء الى منتدانا الحبيب ورواد المنتدى العمل حتى يخرج بهذه الصورة يعلم الله وحده الجهد المبذول به اسال الله تعالى ان يتقبل هذا العمل صدقة جارية الى ما شاء الله تعالى ms access becomes an authorized e-invoicing solution provider in Saudi Arabia by www.officena.net Start your e-invoicing journey حسب متطلبات هيئة الزكاة والضريبة والجمارك السعودية يتم قراءة الرمز الناتج ان شاء الله عبر القارىء الرسمي الخاص بالهيئة ( تطبيق جوال ) حمل من هنا : التطبيق الرسمي لهيئة الزكاة والضريبة والجمارك يتم قراءة الرمز الناتج ان شاء الله عبر قارىء خاص ( تطبيق جوال ) حمل من هنا : تطبيق قرائة رمز الاستجابة طبقات لمتطلبات هيئة الزكاة والضريبة والجمارك التطبيق المقدم لكم تمت تجربته وهو متوافق مع النواتين 32 , 64 تم تصميم الاكواد داخل روتين عام ليسهل التعامل معها بكل سهولة ممكنة حاولت جاهدا جمع الاكواد المستخدمة فى موديول ليسهل نقله يتم التعامل مع الروتين باسناد فقط اسماء الحقول من النموذج المستخدم والتى يمكن تغير اسمائها تبعا لتصميمك كالاتى Call CreateInvoice(ID, SellerName, VatNo, TimeStamp, InvoiceWithVat, VatTotal) ID >>-----> اسم الحقل الدال على رقم الفاتورة وهذا ليتم تسمية ملف رمز الاستجابة الناتج بناء عليه SellerName >>-----> اسم الحقل الدال على اسم البائع VatNo >>-----> اسم الحقل الدال على الرقم الضريبي TimeStamp >>-----> اسم الحقل الدال على الوقت وتاريخ انشاء الفاتورة InvoiceWithVat >>-----> اسم الحقل الدال على القيمة الاجمالية للفاتورة VatTotal >>-----> اسم الحقل الدال على القيمة الاجمالية لمبلغ الضريبة فقط بعد تشفير البيانات يتم اسناد الشفرة الى متغير عام باسمstrHashCode والذى من خلاله يت حفظ البيانات المشفرة داخل الجدول تبعا لكل سجل ---------------------------------------------- الية العمل بعد اسناد اسماء الحقول الى الروتين يتم تمرير البيانات من تلك الحقول الى الملف التنفيذى الملحق مع القاعدة والذى بدورة يقوم بانشاء كل من 1- رمز الاستجابة السريع بعد تشفير البيانات طبقا للمطلبات from string to hex to base64 2- انشاء ملف نص به تشفير البيانات بعد ذلك تقوم باقى الاكواد بجلب البيانات المشفرة من ملف النص واسنادها الى المتغير الذى تم تخصيصه لذلك --------------------------------------------- تفاصيل الاكواد داخل الموديول كالتالى الروتين MkDir لعمل المجلدات عند الحاجة دوال الـ API الخاصة بـ ShellWait والمتوافقة مع كلتا النواتان 32 , 64 وتمت التجربة بنجاح على اوفيس 32 تارة واوفيس 64 تارة اخرى بفضل الله بنجاح حيث يتم ارسال البيانات من الحقول الى الملف التنفيذى الملحق من خلال الروتين Shell_n_Wait ليتم انشاء رمز الاستجابة السريع من خلال الروتين الخاص به وهو CreateInvoice وانشاء الملف النصى بجوار الملف التنفيذى فى نفس المسار لالحاق البيانات المشفرة طبقا للمطلبات from string to hex to base64 وبعد ذلك يتم جلب البيانات المشفرة من خلال الروتين ReadFileToText ولابد من استخلاص التشفير من خلال الروتين StripSpChars للاحتفاظ بالنص دون اى زيادات وبعد ذلك يتم الحاق البيانات المشفرة الى المتغير الذى قمت بتخصيصه لذلك وهو يحمل الاسم strHashCode والذى يتم الحاق البيانات من خلاله لكل سجل الى الحقل المخصص به للاحتفاظ بتلك الشفرة حسب طلبات السادة رواد المنتدى الكرام الملف التنفيذى تم عمله من خلال الفيجوال دوت نت ليقوم بتحويل النص طبقا للمطلبات from string to hex to base64 وتم دمج ملفات الـ Dll الخاصة بانشاء رمز الاستجابة بداخل الملف التنفيذى لسهولة التعامل معه من خلال الاكسس ليكون ملف تنفيذى واحد فقط يتم التعامل معه من خلال الـ Command Line دون الحاجة لتثبيت او تسجيل او الاستعانة بأى مكتبات خارجية او حتى ملحقة بالاكسس وذلك لسهولة نقل الموديول الى اى قاعدة دون التقيد باى مكتبات --------------------------------------------- تنبيه هام جدا جدا جدا بجوار قاعدة البيانات فى نفس مسارها مجلد باسم KSA-QR-Tool لايمكن تغيير اسم المجلد والا يحدث خلل وان استدعت الحاجة تغيير الاسم يجب ذلك داخل المدويول يتم كذلك انشاء ملف نصى اليا داخل المجلد KSA-QR-Tool لذلك يجب تحرى الحذر عند محاولة تغيير اسم المجلد داخل الموديول لذلك يرجى عدم محاولة تغير اسم المجلد كذلك داخل المجلد السابق ذكرة الملف التنفيذى KSAQR.exe لا تحاول تغيير اسم الملف لان الاكواد كذلك تتعامل مع هذا الملف من خلال اسمه كذلك لا يمكن نقل المجلد او الملف من مسار قاعدة البيانات الا بالتعديل على الاكواد وفى الختام فضلا وكرما وليس امرا الرجاء الاهتمام بالرد بما يفيد نتيجة تجربتكم الشخصية وتقييم تلك التجربة فلا تبخلوا علينا بذلك... لكم منا خالص الشكر واتمنى لكم تجربة ممتعة ومن يريد طريقتى والتى احبها وافضلها وتعلمتها من استاذى الجليل ومعلمى الجليل الاستاذ @jjafferr بتحميل الملف التنفيذى داخل القاعدة للتأكد دائما من عدم حذفه لا يتردد فى طلب ذلك فقط حاولت تقديم القاعدة بأبسط شكل حتى يقف كل من يريد استخدامها او نقلها الى تطبيقه الخاص على الاكواد المهمة فقط من خلال موديول واحد فقط تيسيرا وتسهيلا عليه وحتى تعم الفائدة هذه الاكواد المستخدمة فى الملف التنفيذى الذى تم انشاؤه من خلال الـ فيجوال دوت نت بناء على رغبة استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل لمن يريد التعلم من اكواد التشفير وبناء على طلب استاذى القدير @ابوآمنة Imports System.Drawing Imports System.IO Imports System.Text Imports QRCoder Module Module1 Sub Main() Try Dim sellerName As String = "" Dim vatNumber As String = "" Dim timeStamp As String = "" Dim invoiceTotal As String = "" Dim vatTotal As String = "" Dim imagePath As String = "" Dim filePath As String = "" If My.Application.CommandLineArgs.Count >= 6 Then sellerName = My.Application.CommandLineArgs(0) vatNumber = My.Application.CommandLineArgs(1) timeStamp = My.Application.CommandLineArgs(2) invoiceTotal = My.Application.CommandLineArgs(3) vatTotal = My.Application.CommandLineArgs(4) imagePath = My.Application.CommandLineArgs(5) filePath = My.Application.CommandLineArgs(6) Else Environment.Exit(0) End If If Not String.IsNullOrEmpty(filePath) Then File.WriteAllText(filePath, String.Join(" ", sellerName, vatNumber, timeStamp, invoiceTotal, vatTotal), Encoding.UTF8) End If End Dim tlvInvoice = CreateInvoice(sellerName, vatNumber, timeStamp, invoiceTotal, vatTotal) Dim qrGenerator As New QRCodeGenerator() Dim qrData As QRCodeData = qrGenerator.CreateQrCode(tlvInvoice, QRCodeGenerator.ECCLevel.Q) Dim qrCode As QRCode = New QRCode(qrData) Dim qrCodeImage As Bitmap = qrCode.GetGraphic(20) qrCodeImage.Save(imagePath) If Not String.IsNullOrEmpty(filePath) Then File.WriteAllText(filePath, tlvInvoice, Encoding.UTF8) End If Catch ex As Exception End Try End Sub Function CreateInvoice(sellerName As String, vatNumber As String, timeStamp As String, invoiceTotal As String, vatTotal As String) As String Dim invoiceHex As String = "" For i = 1 To 5 Dim txt As String = "" Select Case i Case 1 txt = sellerName Case 2 txt = vatNumber Case 3 txt = timeStamp Case 4 txt = invoiceTotal Case 5 txt = vatTotal End Select Dim hexTxt As String = StringToHex(txt) Dim hexLen As String = Hex(Encoding.UTF8.GetBytes(txt).Length) If hexLen.Length = 1 Then hexLen = "0" & hexLen End If invoiceHex = invoiceHex & "0" & i & hexLen & hexTxt Next Return HexToBase64(invoiceHex) End Function Function StringToHex(txt As String) As String Dim b As Byte() = Encoding.UTF8.GetBytes(txt) Return BitConverter.ToString(b).Replace("-", "") End Function Function HexToBase64(txt As String) As String Dim bytes = New Byte((txt.Length \ 2) - 1) {} For i = 0 To bytes.Length - 1 Dim mi = txt.Substring(i * 2, 2) bytes(i) = Convert.ToByte(mi, 16) Next i Return Convert.ToBase64String(bytes) End Function End Module E-Invoicing.zip Ksa Qr 32x 64x 2007 to 2021 _Last Version.zip

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

أتابع

لدي سؤال استاذ @Ahmed_J اذا اردت ان تقوم بترفيع شخص ما ..من معاون مهندس الى مهندس في شهر اذار ..فلماذا تقوم بمسح جميع السجلات في TB1 ومن ثم الحاقها جميعا الى الجدول TB2 وجميعها تاخذ نفس الشهر مع العلم ان الالحاق يخص شخصا واحد لا اعلم فربما لديك وجهة نظر مختلفة

الأخ @khaledmm عضو جديد ولعله لم ينتبه علي تاريخ الموضوع الذي بحث عنه قبل ان يطرح موضوعه ولعله أراد ان يطرح نفس الموضوع

وعليكم السلام ورحمة الله وبركاته 🙂 اضف هذا السطر في نهاية الكود (هكذا موجود في كود كتبته يوم من الايام ، بس ما فيه ملاحظة في الكود ، فلا اعرف اذا يعمل العمل الذي تريده) : app.UserControl = True جعفر

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

قم بتعديل الكود بهذا الشكل DoCmd.SetWarnings False DoCmd.OpenQuery "Q10" DoCmd.SetWarnings True me.Requery ووافنا بالنتائج

حقيقة لم افهم قصدك ولكن هذا اكود بحاجة لاضافة مكتبة الأوقيس الخاصة بالاصدار الذي تعمل عليه من الــ refrences مثل هذه الصور ملاحظة: يختلف رقم الاصدار حسب الاصدار الذي تعمل عليه فأوفيس 2003 تقريبا اصدار الخاص به 0.11 فأوفيس 2007 تقريبا اصدار الخاص به 0.12 وهكذا وعلي كلا ان لم يكن هذا مرادك فرجاءا زيادة توضيح عن ما المشكلة التي تواجهها

هات مرفق .. أو صورة للكويري ..

أخي @عبدالفتاح في بي اكسيل لك جزيل الشكر على هذا الحل السريع والناجز

عذرا أخي الكريم

@Elsayeh اعتقد ان @lionheart قام باجابتك فهل يعقل بعد الاجابة تقوم بازالة علامة الاجابة وتطلب تعديل جديد .😱 كان من الاجدر ان تضع جميع متطلباتك من البداية والا فتح موضوع جديد. يجب ان تعلم اضافة متطلبات جديدة ستفقد حماس الاخرين لمساعدتك كما ان تصميم الكود ليس هين 😡 واعتقد ان @lionheart اعطاك كود قوي وسريع 😎

تفضل جرب هذا والتعليمات الجديدة في آخر صفحة إرسال رسائل عبر الوتساب3.xlsm

هذا الفورم به زر تصدير إلى أكسل يمكن أخد الماكر وعمل مثله للتصدير ألى أكسل بكل بساطة ويمكن أضافة الشروط حسب مصدر الفورم وعليك التجويد والتحديث كما يساهم فى الأفضل للبرنامج الخاص بك New Microsoft Access Database (3).accdb

السلام عليكم أخي الكريم تم إخفاء يوم الجمع بالتنسيق الشرطي =AND(WEEKDAY(DATE($J$2;$J$1;COLUMN(A1048576));15)=1) ملف.xlsx

الف شكر اخي محمد حسن المحمد جزاك الله خيرا

لا تجعل المعايير بصف واحد ضع واحد في سطر المعايير والآخر في السطر ( او ) اللي تحته الآن في مثالك كأنك تقول : خذ من مربع التحرير 1 ( and ) مربع التحرير2 واذا وضعت المعيار الثاني في السطر الثاني كأنك تقول : خذ من مربع التحرير 1 ( Or ) مربع التحرير2 Query.accdb

في مثل طلبك قد تحتاج الى حقل او اكثر في الجدول يحتوي على توصيف لما تريد ان تقوم بتصفيته مستقبلا عملت لك حقلا للوصف في جدول الاعاقة وآخر للتصفية حسب الرغبة هكذا يمكنك التحكم بظهور البنود واحدا واحدا وايضا اختيار ما تريد ضمهما الى بعض وفصل ما تريد 218.rar

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

The name in cell C10 should have a space between the first name and last name so as to be identical as the name in cell C5 Sub Test() Dim a, txt As String, i As Long, ii As Long a = Range("C5:G" & Cells(Rows.Count, "C").End(xlUp).Row).Value With CreateObject("Scripting.Dictionary") For i = 1 To UBound(a, 1) txt = a(i, 1) If Not .Exists(txt) Then .Item(txt) = .Count + 1 For ii = 1 To UBound(a, 2) a(.Count, ii) = a(i, ii) Next ii Else For ii = 2 To UBound(a, 2) a(.Item(txt), ii) = a(.Item(txt), ii) + a(i, ii) Next ii End If Next i i = .Count End With [J6].Resize(i, UBound(a, 2)) = a End Sub

عدلت لك الكود ليقبل أكثر من ملف ويحفظ كل مسار في سجل جديد ..

السلام عليكم ورحمة الله فى الكود الاول اجعل آخر سطرين هكذا End With Call Macro2

السلام عليكم أخي الكريم تفتح الفورم ...تنظر في خصائص اليوزرفورم... كلمة Picture مسجل بجانبها None لا توجد صورة اضغط على زر بثلاث نقاط بجانبها تستطيع من خلاله اختيار صورة ..اختر الصورة التي تريد لتكون خلفية لشاشة الفورم. تقبل تحياتي test .xlsb

تفضل هذا هو الكود 🙂 : Sub GetFiles() Dim fdialog As Office.FileDialog Dim filepath As String Dim Item As Variant Set fdialog = Application.FileDialog(msoFileDialogFilePicker) With fdialog .Title = "Select image" .AllowMultiSelect = True .Filters.Clear .Filters.Add "Image file", "*.jpg ; *.bmp ; *.png" If .Show Then For Each Item In .SelectedItems DoCmd.GoToRecord , , acNewRec filepath = .SelectedItems(1) [PthIn1] = filepath Next Else Exit Sub End If End With MsgBox "تم إضافة الملفات بنجاح" End Sub

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

السلام عليكم سأشرح كيف اني أشير الى مكان وجود الجداول (سواء المضمنة او المرتبطة)، والذي سيكون مجلد الصور سيكون معه في نفس المجلد ، يعني مجلد الصور دائما يجب ان يكون في نفس مجلد قاعدة البيانات التي تحتوي على الجداول (بغض النظر ، سواء أكانت قاعدة البيانات واحدة او مقسمة). نضع هذا الكود في وحدة نمطية: Public Function GetDBPath() As String Dim strFullPath, Table_Name As String Dim rst As DAO.Recordset 'check for a linked table Set rst = CurrentDb.OpenRecordset("SELECT Name FROM msysObjects WHERE Type=6 AND Left([Name],2) Not In ('~t','ms')") If rst.EOF Then 'Table doesn't exist Exit Function Else 'linked Table exists Table_Name = rst(0) End If rst.Close Set rst = Nothing 'now get the path strFullPath = Mid(DBEngine.Workspaces(0).Databases(0).TableDefs(Table_Name).Connect, 11) GetDBPath = Left(strFullPath, InStrRev(strFullPath, "\")) End Function Public Function BE_or_FE() ' to use: ' BE_or_FE ' 'if BE exits, use its path, 'otherwise use the Application path 'get the BE Path BE_or_FE = GetDBPath If Len(BE_or_FE & "") = 0 Then BE_or_FE = Application.CurrentProject.Path End If End Function Function Images_Location() 'If we want the Backend Folder Images_Location = BE_or_FE & "\archive" 'or we can assign any location we want 'Images_Location = "c:\Temp" & "\archive" End Function وعندما اريد ان اعرف مسار الجداول (بغض النظر في كون الجداول مضمنه او مرتبطة) ، فاناديه هكذا: msgbox BE_or_FE وعندما اريد ان اعرف مسار مجلد الصور ، فاناديه هكذا: msgbox Images_Location وعندما اريد ان اشير الى الصورة التي اشرت اليها انت ، فاناديه هكذا: Images_Location & "\" & txt1 & ".jpg" جعفر

تم دمج الموضوعين والتعديل على الملف المرفق حسب الطلب DB1.rar