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

السلام عليكم اسعد الله صباحكم تجربتي في الاكسس ليست بالبعيده ومازلت اتعلم واحببت ان اذكر اهم نقاط مهمله يجب الانتباه لها لجعل برنامجك يعمل بشكل جيد .. نبدأ في النقاط الـ 6 الأولى وبإذن الله سيتم إنعاش الموضوع كل يوم .. الموضوع مفتوح للجميع ويمكن إضافه إثرائك بما يجود به من علمك ولكن اجعله مبسط وقابل للفهم بالنسبه للمبتدئين 1- اسماء الحقول في الجدول + اسماء كافة العناصر لا اقول يجب لأنه عمليا تستطيع كتابتها بالعربي ولكن الافضل الافضل الافضل ان تكون بالانجليزي ويفضَل بدون مسافات وتستطيع استبدال المسافه بـ ( _ ) ولا بأس في التسميات التوضيحيه في النماذج والتقارير ان تكتب مايناسبك في العربي واستخدم المسافه - اهتم بأسماء العناصر ليسهل عليك معرفتها مثلا نموذج لإضافة موظف جديد( employees_form_add ) لماذا ؟ - تجنب الاخطاء عند كتابه الاكواد في منشئ التعبير واكواد ال vba وغيرها .. - تجنب اخطاء الترميز في لغات الويندوز ربما لا يعمل برنامجك في جهاز ترميز اللغه العربيه يكون غير معروف. ----------------------------------------------------------------------------- 2- حجم الحقل (اي عدد الحروف) ضروري جدا الاهتمام به و يكون متناسب مع نوعية البيانات الافتراضي دائما يكون (250) فمثلا بحقل الاسم ولنفترض ان هناك موظف اسمه (عبداللطيف عبدالرحمن عبدالملك عبدالله الاوفيسي) في الاسم اعلاه جميع الحروف مع المسافات عددها (45 حرف) إذا ... ؟ باقي هناك 205بت حجزت وزادت بحجم القاعده تم حجزة بدون فائده. - ستجد ان بعض الحقول تحتاج فقط 5 أحرف ومنها جنس الموظف إما ذكر او انثى .. إذا لماذا 250 حرف ف الافضل تقليصها بما يتناسب مع بيانات الحقل ----------------------------------------------------------------------------- 3- لديك مثلا جدول موظفين وفيه عدد 15 حقل وتريد اضافه نموذج (عناصر متعدده) (عناصر متعدده يعني كل موظف تنعرض بياناته في سطر والسطر الثاني للموظف الثاني وهكذا) غير ضروري انك تعرض البيانات كامله وتقدر تضيف فقط حقل الاسم والرقم الوظيفي والجنس والجنسيه وبكل بساطه تقدر تسوي زر في حال اردت عرض البيانات كامله يوجهك إلى نموذج تنعرض كامل البيانات فيه يكون قدام كل موظف وهذا اجمل واكمل مثال - الافضل في نماذج العناصر المتعدده الغاء الاضافه وتتم الاضافه في نموذج خاص بالاضافه. - نموذج عرض البيانات لا تجعله يستند إلى استعلام الافضل تتم برمجة زر عرض البيانات لجلب النموذج وعرض بيانات الموضف استنادا إلى رقم الموظف لماذا لكي تستفيد من نموذج عرض البيانات في ازرار اخرى ولا يكون حصري على نموذج تصفح الموظفين. ----------------------------------------------------------------------------- 4- عند انشائك لأي نموذج يعرض بيانات موظف واحد فقط اي سجل واحد وليس هناك أي ازرار تنقل لتسريع عملية فتح النموذج وتجنب بطئ القاعدة والافضل هو ان تجعل هذا النموذج دورة في السجل الحالي فقط لكي لا يتم صف السجلات الاخرى في الخلفيه بإنتظار المستخدم للإنتقال إلى السجل التالي وعرضه واساسا ليس هناك اي زر تنقل وإنما النموذج خصص لعرض سجل واحد فقط .. الطريقه | من خصائص النموذج > إذهب لغير ذلك > من خاصية دورة اختار (السجل الحالي) ----------------------------------------------------------------------------- 5- بعض الازرار تكون مكرره في اغلب النماذج مثلا ( الاضافه - الحذف - الحفظ - البحث الافتراضي - التنقل ) وهذه الازرار لا تحتاج إلى معرفة اسم النموذج هو يقوم بالأمر في السجل الحالي بغض النظر عن اسم النموذج وانت بدورك كمبرمج تطمح إلى مزيد من التقدم والاحترافية يجب ان تكون ذكيّا لتقلل الاكواد او المايكرو المكرر في كل نموذج م الحل ؟ ببساطه اجعل كود حفظ او اضافه او الحذف في وحدة نمطيه واستدعها متى ما شئت في الزر المناسب مثلا: اجعل كود الحذف في وحده نمطيه ك التالي : ومن ثم من زر الحذف الموجود في النموذج عند حدث عند النقر اكتب مايلي وهو الاستدعاء : كرر عملية الاستدعاء في ازرار الحذف الاخرى كما يمكنك استخدام المايكرو بدلا من الوحده النمطيه واستدعاءه في اي زر اذا كنت ما زلت لم تستخدم الاكواد انشئ مايكرو وضع فيه امر الحذف كما يلي: ثم في حدث عند النقر في زر الحذف استدع المايكرو كما يلي: كرر عملية الاستدعاء في ازرار الحذف الاخرى م الفائده : تقليل الاكواد او المايكرو مما يساهم في تقليل الاخطاء وتسريع القاعده ----------------------------------------------------------------------------- 6- كـ لمسه فنية إذا اردت تغيير اسم النموذج الذي يظهر في اعلى عند شريط القائمة الواضح هنا .. ولأنك التزمت في النقطه السابقه بعدم تسيمة النماذج بالعربيه كيف إذا تعيد تسميتها بالعربي وبأي مسمى ؟ الحل بكل بساطه .. عند حدث في الحالي بالنموذج الذي تريد تغغير مسماه اكتب الكود البسيط التالي : Me.Caption = "اكتب هنا الاسم الذي ترغب ان يظهر في اعلى النموذج" ----------------------------------------------------------------------------- نكتفي بهذا القدر على امل بكم في النقاط ال 6 الاخرى غدا بإذن الله

السلام عليكم ورحمة الله وبركاته التطبيق اهداء الى منتدانا الحبيب ورواد المنتدى العمل حتى يخرج بهذه الصورة يعلم الله وحده الجهد المبذول به اسال الله تعالى ان يتقبل هذا العمل صدقة جارية الى ما شاء الله تعالى 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

طيب يا عم ...... فكرتين لطريقتين : الاولى : استخدام HTML في اظهار الصور الموجودة في الملجلد وقد لمح لها أخي الفاضل @jjafferr في طريقة الاستاذ القدير @ابو إبراهيم ولهما مني التحية والتقدير الثانية : استخدام عملية توزيع للمسارات على حقول في جدول لنتمكن من عرض الصور بشكل شبكي ملاحظة : عند فتح المجلد المراد اختر واحدة من الصور فقط والبرنامج يقوم بجلب جميع صور المجلد .... تفضل ........ هناك فكرة ثالثة ... لكن للاسف لم اتمكن حتى الان من تطبيقها لضيق الوقت ... Kan_first idea.accdb Kan_second idea.accdb

السلام عليكم تفضل اخي الكريم Database3.rar تحياتي

بدل العلاقة بين الجدولين ، انا عملت العلاقة بين النموذج الرئيسي والفرعي ، ولكن ، تفضل . واضفت حقل لتسلسل العائلة/الاطفال . . في النموذج الفرعي ، ولما تكتب اسم من اسماء افراد العائلة ، وعند حدث "بعد التحديث" ، يحصل الاسم على الرقم التلقائي التالي ، بهذا الكود: Private Sub الاسم_AfterUpdate() 'Get the Next Seq number for this child Me.Childern_ID = Nz(DMax("[Childern_ID]", "tb2", "[Father_ID]=" & Me.Parent!id), 0) + 1 End Sub جعفر 1433.test.accdb.zip

السلام عليكم محتاج كود لجلب رقم المازر بورد لاني عامل حماية برقم الهارد ديسك وللاسف لما الكمبيوتر بيتفرمت بيتغير

سؤال: ايش بتعمل في الصور ، هل هي للعرض فقط ، او تريد تستعملهم لشيء آخر ؟ جعفر

لما يكون النموذج في وضع Dialog (مو منبثق Popup) فيكون مثل نافذة رسائل الاكسس: بحيث لا تستطيع ان تستخدم اي من كائنات قاعدة البيانات ، غير الموجودة في نافذة الرسالة ، يتوقف الكود عند هذا السطر ولا يتحرك للسطر التالي إلا بعد اغلاق النافذة. لهذا السبب يجب عدم استخدام هذه الخاصية (النماذج) إلا في حالات جدا خاصة. الطريقة الاولى: لحل هذه المشكلة ، يجب علينا ارسال جميع المعلومات المطلوبة ، ضمن امر فتح النموذج FRM2 ، ويمكننا عمل هذا عن طريق المتغير OpenArgs الموجود كآخر متغير في امر فتح النموذج ، فيكون الكود: Private Sub Frm2_Click() 'since we open the Form in a Dialog mode, 'we cannot send any further lines of code until the Form is closed 'so while opening the Form, we will send further info in "OpenArgs" variable 'so that when Form 2 is open, we can process this data there. 'Coming from:FRM1, setfocus field:TNO, TNO value: me.TNO DoCmd.OpenForm "FRM2", acNormal, , , , acDialog, "FRM1|TNO|" & Me.TNO End Sub . وفي حدث "تحميل" النموذج FRM2 ، نطلب منه تحليل هذه المعلومة ، والقيام بالمطلوب : Private Sub Form_Load() On Error GoTo err_Form_Load If IsNull(Me.OpenArgs) Then GoTo No_OpenArgs Dim x() As String 'OpenArgs info: 'Coming from:FRM1 'setfocus field:TNO 'TNO value: me.TNO If Split(Me.OpenArgs, "|")(0) = "FRM1" Then x = Split(Me.OpenArgs, "|") Me(x(1)).SetFocus DoCmd.FindRecord x(2), , , , , , True End If No_OpenArgs: 'continue code here Exit_Form_Load: Exit Sub err_Form_Load: If Err.Number = 2142 Or Err.Number = 94 Or Err.Number = 9 Then 'ignore, No proper value from OpenArgs Resume No_OpenArgs Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_Form_Load End If End Sub . الطريقة الثانية: Private Sub Frm2_Click() DoCmd.OpenForm "FRM_02", acNormal, , , , acDialog End Sub . وفي حدث "تحميل" النموذج FRM2 ، Private Sub Form_Load() On Error GoTo err_Form_Load Me.TNO.SetFocus DoCmd.FindRecord Forms!FRM_01!TNO, , , , , , True No_FRM: 'continue code here Exit_Form_Load: Exit Sub err_Form_Load: If Err.Number = 2145 Then 'ignore, No proper value from incoming Form Resume No_FRM Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_Form_Load End If End Sub . جعفر

أحسنت صنعاً .. لك جزيل الشكر وعظيم الإمتنان ☺️

وعليكم السلام 🙂 وانا ادلو بدلوي : DoCmd.OpenForm "frm_03" Forms!frm_03!Id.SetFocus 'لست بحاجة الى هذا السطر DoCmd.FindRecord Me.Id, , , , , , True . الطريقة : كأنك فتحت النموذج الآخر وعملت Ctl+F ، فعندك جميع الاعدادات في نافذة البحث ، في السطر الاخير من الكود 🙂 جعفر

الملف شغال تمام وما فى اى مشاكل وع العموم انا قمت بتعديل ليتماشى مع النواتان 32 , 64 menu.zip

السلام عليكم ورحمة الله وبركاته وبها نبدأ تفضل اخى احمد مشكله ملفك ان التواريخ لم تكن بصيغه تواريخ تم التعديل في المرفق عدد 291 موظف.xlsx

بالفعل، لكن يمكن تطويع الhtml لخدمة الأكسس. انا لم اتكلم عن قوة الأكسس كـ برنامج خدمي وسهل وو.. تكلمت فقط عن امكانياته المحدودة في التصميم مقارنة بالبرامج الاخرى، ومثل ما تفضلت يبقى المصمم هو فارس الميدان في جعل الشكل جذاب ومرتب. وكـ مبادرة صغيرة مني في دعم موضوعك الرائع اقدم لكم واجهة بسيطة قمت بتصميمها في الاكسس واهم مايميزها responsive مع جميع الشاشات، اتمنى لكم الفائدة من هذه الواجهة وبنفس الوقت لا تتوقعو مني الكثير في تصميم الواجهات فأنا لا ازال في بداية الطريق اهلا عزيزي ابا جودي، لك وحشة ياغالي.. بالعكس انا لم اقل الاكسس عاجز وانما قلت ان الاكسس محدود اما عن الresponsive فأنا قمت بشرحها سابقا في هذا الموضوع، ربما طريقتك تختلف عن طريقتي لكن يبقى الجوهر واحد تحياتي لك ابا جودي menu.rar

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

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

وعليكم السلام 🙂 على زر تنفيذ الامر ، استعمل هذا الكود: docmd.setwarnings false docmd.openquery "اسم الاستعلام" docmd.setwarnings true جعفر

السلام عليكم ورحمة الله لعل هذا الكود ان يفى بالغرض Sub ReArrang_Data() Dim ws As Worksheet, C As Range Dim i As Long, p As Long Set ws = Sheets("Sheet1") p = 3 i = 6 Do While i <= 16 For Each C In ws.Range(Cells(4, i), Cells(19, i)) If Len(C) > 0 Then p = p + 1 ws.Cells(p, 2) = C.Value ws.Cells(p, 3) = C.Offset(0, 1).Value End If Next i = i + 2 Loop End Sub

لقد سبقتك يا رجل 🤭

اعرض الملف ksa e-invoicing تم التعديل ليتناسب مع نسخ الاوفيس بدأ من 2007 وحتى 2021 للنوتان 32 , 64 التطبيق اهداء الى منتدانا الحبيب ورواد المنتدى ولكن اشهد الله تعالى ان هذا العمل مقدم لكل من يريده مجانا وعلى سبيل الهدية لوجه الله تعالى ولا اسمح نهائيا ببيعه اللهم انى بلغت اللهم فاشهد العمل حتى يخرج بهذه الصورة يعلم الله وحده الجهد المبذول به اسال الله تعالى ان يتقبل هذا العمل صدقة جارية الى ما شاء الله تعالى ms access becomes an authorized e-invoicing solution provider in Saudi Arabia by www.officena.net Start your e-invoicing journey حسب متطلبات هيئة الزكاة والضريبة والجمارك السعودية يتم قراءة الرمز الناتج ان شاء الله عبر القارىء الرسمي الخاص بالهيئة ( تطبيق جوال ) حمل من هنا : التطبيق الرسمي لهيئة الزكاة والضريبة والجمارك يتم قراءة الرمز الناتج ان شاء الله عبر قارىء خاص ( تطبيق جوال ) حمل من هنا : تطبيق قرائة رمز الاستجابة طبقات لمتطلبات هيئة الزكاة والضريبة والجمارك متطلبات التشغيل : Framework الاصدار 4 ------------------------------------------------------------------------------- يمكن تحميل الملف الاتى هو يقوم بالتحديثات اللازمة سواء ويندوز 7 , 10 , 11 إذهب الى موقع التحميل : من هنا ( تحميل مباشر من mediafire .. من رفعي انا على حسابي الشخصي بالموقع ) ميزات برنامج All in one Runtimes: سهل الاستخدام و مفيد للغاية في تقليل الزمن الضروري للبحث عن الأدوات كلٍ على حدا. مجاني بشكل كامل و يقدم الكثير من الفائدة و يمكنه حمايتك من المواقع التي قد تصيب جهازك بفيروسات سيئة عند التحميل منها. يعمل بشكل ذكي حيث يقوم بتحديد ما يحتاجه حاسبك و لن يقوم بتثبيت كل الأدوات بشكل عشوائي. يقدم مجموعة كبيرة من الأدوات الضرورية في حاسبك و أهمها: .NET Framework 4.6 + Updates Java Runtime Environment 8 DirectX 9.0c Extra files General runtime files Microsoft Visual C++ Runtimes (v2005 – v2015) Microsoft Visual J# 2.0 SE Microsoft Silverlight 5 Shockwave Player 12 (Internet Explorer Plugin) ------------------------------------------------------------------------------- الجديد فى هذا الموضوع وسبب تطوير تلك القاعدة . نظرا للمشاكل التي واجهت أحبابي سابقا بسبب تسجيل الملفات .. تم بفضل الله تعالى حل كل المشاكل تقريبا لن نحتاج الى نقل مجلد ملفات مكتبات الـ DLL الى أي مكان يتم إنشاء المجلد اليا بنفس مسار القاعدة يتم تحميل الملفات من قاعدة البيانات اليا تشغيل ملف التسجيل Register.bat اليا.. عند فتح القاعدة للمرة الأولى ومحاولة انشاء رمز الـ Qr وفى حالة عدم تسجيل مكتبة الجافا يتم اغلاق القاعدة اليا وفتح ملف التسجيل كمسؤول نظام دون أي تدخل من المستخدم نهائيا مميزات القاعدة الحفاظ على الملفات الهامة بحملها داخل القاعدة وتحميلها لمسار القاعدة فى كل مرة يتم فيها فتح القاعدة شغيل ملف التسجيل Register.bat اليا عند الحاجة لذلك يدعم النواتان 64 , 32 تشفير البيانات طبقا لمتطلبات هيئة الزكاة والضريبة والجمارك السعودية الاحتفاظ بالبيانات المشفرة لكل سجل حجم الصورة الخاصة برمز الاستجابة السريع QR CODE صغير جدا لمن يريد الاحتفاظ بهم لكل سجل أتمنى لكم تجربة ممتعة ... الفائدة من تصميى المتواضع وافكارى والمميزات حمل ملفاتى الهامة داخل القاعدة وبذلك لن يتم فقدانها مطلقا لاى سبب الا بفقد القاعدة نفسها عند نقل القاعدة لاى جهاز يتم وضع الملفات بتحميلها من القاعدة الى الجهاز اليا فى مسار القاعدة فلن يشغل بال المستخدم اى شئ بخصوص ملفات المكتبات عند عدم تسجيل المكتبات يتم ذلك اليا دون ادنى تدخل من المستخدم يتم فتح الملف الدفعى اليا فى حالة عدم تسجيل المكتبات وهو يعيد تشغيل نفسه كمسؤل ويقوم باللازم عند الانتها للملف الدفعى من التسجيل للمكتبات يعيد فتح القاعدة اليا واغلاق نفسه وجب التنويه لبعض النقاط لمن يريد نقل الافكار الى عمله مراعاة والاخذ فى الاعتبار عند محاولة تغيير اسم القاعدة ان اردتم لابد من تغيره كذلك بنفس الاسم الجديد فى الملف الدفعى حيث انه يقوم بفتح القاعدة اليا بعد التسجيل مراعاة الاخذ فى الاعتبار عند محاولة تغيير اسم النموذج frmElcInvoicing تغير الاسم كذلك فى نموذج البدأ UsysfrmInsertAllObjects الحرص على وجود الجدول UsystblBlob و الموديول UsysmodBlob والنموذج UsysfrmInsertAllObjects لانهم المختصون بحمل ملفات المكتبات داخل القاعدة وتحميلها وتسجيلها بشكل آلى بالهناء لكم وبالتوفيق للحميع ان شاء الله صاحب الملف ابو جودي تمت الاضافه 20 ديس, 2021 الاقسام قسم الأكسيس  

بارك الله بك

خطة 2022.xlsx

جرب المعادلة =SUMIF(D2:D13;"<>عجز الفترة";C2:C13)

استبدل With Sheets("Sheet3").PageSetup .FitToPagesWide = 1 .FitToPagesWide = False End With بـ With Sheets("Sheet3").PageSetup .Zoom = 100 End With

وفيه هذه المعادلة =IF(COUNTIF(C6,"* 1*"),3,5) المصنف1 (2) (1).xlsx

جرب المعادلة =IF(ISNUMBER(SEARCH("1",C10)),3,5) شوف المرفق المصنف1 (2).xlsx

عدد الموظفين حسب السنة.xlsx

معك حق تفضل أخي الكريم Vente-4.xlsm

السلام عليكم ورحمة الله الكود التالى يقوم بانشاء ورقة جديدة فى خالة عم وجودها Sub CrNewSheets() Dim dic As Object, Tmp As Variant, Itm Dim i As Long, Bok As Worksheet Set Bok = Sheets("BASS") Set dic = CreateObject("scripting.dictionary") Tmp = Bok.Range("E5:E" & Bok.Range("C" & Rows.Count).End(3).Row).Value For i = 1 To UBound(Tmp) dic(Tmp(i, 1) & "") = "" Next On Error Resume Next For Each Itm In dic.keys If Len(Trim(Itm)) > 0 Then If Len(Worksheets(Itm).Name) = 0 Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = Itm End If End If Next End Sub ضعى هذه العبارة فى اول سطر فى الكود المدرج بمشاركتى الاولى Call CrNewSheets و الزر يخصص للكود الاول فقط

Rename the data sheet to Data and create another sheet and name it Result OR change the sheet names in the code Sub Test() Const lRows As Long = 20, lCols As Long = 13 Dim ws As Worksheet, sh As Worksheet, rHeaders As Range, r As Long, lr As Long, m As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Data") Set sh = ThisWorkbook.Worksheets("Result") sh.Cells.Clear Set rHeaders = ws.Range("A1:M1") lr = ws.Cells(Rows.Count, 1).End(xlUp).Row For r = 2 To lr Step lRows m = sh.Cells(Rows.Count, "H").End(xlUp).Row + 1 m = IIf(m = 2, 1, m) rHeaders.Copy sh.Range("A" & m) With sh.Range("I" & m) .Interior.Color = vbYellow .Offset(, 2).Interior.Color = vbYellow End With ws.Range("A" & r).Resize(lRows, lCols).Copy sh.Range("A" & m + 1) With sh.Range("H" & m + lRows + 1) .Value = "Total": .Font.Bold = True .Offset(, 1).Formula = "=SUM(R[-1]C:R[-" & lRows & "]C)" .Offset(, 3).Formula = "=SUM(R[-1]C:R[-" & lRows & "]C)" .Resize(1, 4).Interior.Color = vbYellow End With Next r With sh.Cells .FormatConditions.Delete: .ReadingOrder = xlRTL .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .RowHeight = 23 .Columns(9).ColumnWidth = 10 .Columns(11).ColumnWidth = 14 .Font.Size = 14: .Font.Name = "Arial" End With Application.CutCopyMode = False On Error Resume Next sh.Range("I" & m & ":I" & m + lRows + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 sh.Range("A1").CurrentRegion.Borders.Value = 1 Application.ScreenUpdating = True MsgBox "Done", 64 End Sub

الحمد لله

أها اعتقد اني فهمت بشكل خاطئ المشكلة بالنسخ اذا ربما حسب ما فهمت Myrow = Val(TextBox1.Text)+3 Rows(Myrow).Copy

السلام عليكم ورحمة الله وبركاته.. الكثير يجهل امكانية الأكسس في جعل البرامج بشكل responsive أي انه: لو كانت لديك شاشة كبيرة سيتغير شكل برنامجك وتوزيع الأزرار والعناصر لتتناسب مع حجم الشاشة ولو كانت الشاشة صغيرة ايضا ستتغير اماكن العناصر لكي تتناسب مع طبيعة الشاشة وعدم فقدان أي عنصر او ضياعه عندك تغيير الشاشات. قبل البدء، سأقدم لكم مثال على ما اقصده: هذا اخر مشاريعي في الأكسس وهو يتغير تبعاً لأختلاف الشاشات. لنبدأ: سأقوم بوضع Button في منتصف الشاشة بحيث لا يتغير مكانه لو تغير حجم الشاشة ثم قم بعملية الأدراج من جميع الأماكن ( يسار, يمين, أعلى , أسفل ) بحيث يصبح كالأتي: ثم من الطرف اليمين، نختار الأرتساء الأفقي ( كلاهما ) وكذلك الحال بالنسبة لليسار كذلك الحال نطبق على الأعلى والأسفل لكن هذه المرة سوف نعدل الأرتساء العمودي وكذلك بالنسبة للأعلى جرب الآن وسوف ترى ان الـ Button سيبقى في الوسط مهما تغير حجم الشاشة لو وضعت شاشة كبيرة أو صغيرة سيظل بنفس مكانه في الوسط. أي سؤال أنا موجود، تحياتي لكم.

بسم الله الرحمن الرحيم الحمد لله الواحد القهار، العزيز الغفار، مكور الليل على النهار ، تذكرة لأولي القلوب والأبصار وتبصرة لذوي الألباب والاعتبار ، الذي أيقظ من خلقه من اصطفاه فزهدهم في هذه الدار، وشغلهم بمراقبته وإدامة الأفكار ، وملازمة الاتعاظ والادكار، ووفقهم للدؤوب في طاعته والتأهب لدار القرار، والحذر مما يسخطه ويوجب دار البوار، والمحافظة على ذلك مع تغاير الأحوال والأطوار. أحمده أبلغ حمد وأزكاه، وأشمله وأنماه. أما بعد: رأيت أن أقدم عملا خالصا لوجه الله الكريم لعل الله يتغمدنا برحمته ولذا رأيت أنا الفقير إلى الله المحمدي عبد السميع عبد الغني أن أجمع الأكواد بطريقة منظمة تسهل للجميع الحصول عليها عند استخدام محرك البحث ، ولهذا ساقدم سلسلة من الأكواد كل كود بعنوان واضح يسهل الوصول له في موضوع مستقل وسأشرح كيفية استخدام الكود ماتيسر لي إن شاء الله وعلى الله قصد السبيل ****************************************** هذا كود ترحيل أعمدة معينة في هذا الكود سيتم ترحيل الأعمدة الموجودة في الصفحة المصدر ( الشيت ) ويمكن تغييرها الى أي أعمدة تبغاها ("a1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,di1,dj1"). طريقة الاستفادة من الكود افتح ملف اكسيل اضغط على الرز ALT وانت ضاغط على الزر اضغط على F11 الموجود أعلا لوحة المفاتيح ستظهر شاشة الماكرو اضغط على موديول 1 سيتم فتح الموديول الصق فيه الكود الموجود تحت هذا السطر [/center] ''' هذا الكود للعالم العلامة / عبد الله باقشير Sub KH_START1() Dim R As Integer, M As Integer, N As Integer Sheets("كشف ناجح").Range("B7:Es1000").ClearContents Sheets("كشف الدور الثاني").Range("B7:Es1000").ClearContents ''' عدد الصفوف العليا في الصفحات المنقول اليها البيانات M = 6: N = 6: S = 6 Application.ScreenUpdating = False ''' بداية ونهاية صفوف الورقة المصدر For R = 11 To 700 ''' رقم عمود المعيار وكلمة المعيار If Cells(R, 113) = "ناجح" Then M = M + 1 ''' أسماء الأعمدة المطلوب نسخها Range("A" & R).Range("a1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,di1,dj1").Copy ''' سيتم اللصق في هذا الشيت With Sheets("كشف ناجح") ''' سيتم اللصق بدءا من عمود .Range("B" & M).PasteSpecial xlPasteValues .Range("B" & M).PasteSpecial xlPasteFormats .Range("B" & M) = M - 6 End With Application.CutCopyMode = False ''' للصفحة الأخرى المطلوب الترحيل إليها 'رقم عمود المعيار وكلمة المعيار ElseIf Cells(R, 113) = "دور ثان في" Then ''' لترك صف اعلا كل صف N = N + 2 ''' أسماء الأعمدة المطلوب نسخها Range("A" & R).Range("a1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,di1,dj1").Copy ''' سيتم اللصق في هذا الشيت With Sheets("كشف الدور الثاني") .Range("B" & N).PasteSpecial xlPasteValues .Range("B" & N).PasteSpecial xlPasteFormats .Range("B" & N) = (N - 6) / 2 End With Application.CutCopyMode = False End If Next MsgBox "تم ترحيل " & M - 6 & " طالب ناجح" & Chr(10) & Chr(10) & _ "تم ترحيل " & (N - 6) / 2 & " طالب دور ثاني", vbMsgBoxRight, "الحمدلله" Application.ScreenUpdating = True End Sub ودمتم في حفظ الله ترحيل مفيد باختبار اعمدة معينة.rar

Option Explicit 'هذا الكود للمحترم النابغه ياسر خليل 'الهدف من الكود هو ترحيل بشرط 'تم هذا الكود في 15/2/2017 Sub UsingArrays() Dim arr As Variant Dim temp As Variant Dim lr As Long Dim i As Long Dim j As Long Dim c As Long Sheets("Sheet2").Range("A4:Z1000").ClearContents 'متغير اسم ورقة المصدر lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'متغير اسم ورقة المصدرومدى البيانات بها arr = Sheets("Sheet1").Range("A2:C" & lr).Value ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2)) j = 1 For i = LBound(arr, 1) To UBound(arr, 1) ' المعيار او الشرط الذي نبحث به If arr(i, 3) Like "*" & "نا*" & "*" Then For c = LBound(arr, 2) To UBound(arr, 2) temp(j, c) = arr(i, c) Next c j = j + 1 End If Next i 'متغير اسم ورقة الهدف واسم الخليه التي سيتم ترحيل العناوين اليها Sheets("Sheet2").Range("E5").Resize(, UBound(temp, 2)).Value = Array("الاسماء", "الدرجات", "الحالة") 'متغير اسم ورقة الهدف واسم الخليه التي سيتم الترحيل اليها Sheets("Sheet2").Range("E6").Resize(j - 1, UBound(temp, 2)).Value = temp 'سطر لمسح التسطير Sheets("Sheet2").Range("E5:G" & Rows.Count).Borders.Value = 0 'سطر لاضافة التسطير Sheets("Sheet2").Range("E6").CurrentRegion.Borders.Value = 1 End Sub كود الاستدعاء بشرط .. مع التحسينات في التسطير استدعاء بشرط.rar

ترحيل اعمده معينه لاعمده اخرى في شيت اخر معينه Option Explicit 'هذا الكود للمحترم النابغه ياسر خليل 'الهدف من الكود هو ترحيل اعمده معينه لاعمده اخرى معينه 'تم هذا الكود في 15/2/2017 Sub Test() Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long Dim lr As Long 'متغير اسم ورقة المصدر lr = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row 'متغير اسم ورقة المصدرومدى البيانات بها arr = Sheets("Sheet1").Range("A1:K" & lr).Value 'الأعمدة المطلوب الترحيل إليها cr = Array(3, 5, 9) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(2, 6, 10) Sheets("Sheet2").Cells(1, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub استدعاء اعمد معينه لاعمده اخرى معينه.rar

ترحيل او استدعاء راءع ''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''' Sub NAGEH() ''هذا الكود للعبقري ياسر العربي حفظه الله '' تم هذا الكود بتاريخ 8 / 10/ 2016 ''الهدف من الكود هو استدعاء بيانات ''شرح الكود '' Dim myArray, lr, X, targt, targt1, targt2, targtN Dim SERCH As Worksheet, DATA As Worksheet '____________________________________________ Set DATA = Worksheets("رصد الترم الثانى") 'اسم شيت المصدر Set SERCH = Worksheets("كشف ناجح") 'اسم الشيت الهدف '____________________________________________ Range("A8:R1000").Clear 'النطاقات متغيره Range("B7:R7").AutoFill Destination:=Range("B7:R" & Range("A4").Value + 6), Type:=xlFillDefault lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row + 2 'اخر صف به بيانات 'رقم عمود البدايه اللي بعد المسلسل ' متغير SERCH.Range("C7:N" & SERCH.Cells(Rows.Count, 3).End(xlUp).Row + 1).ClearContents 'مسح نطاق البحث القديم targt = "له* دور ثان في" 'معيار البحث 'نطاق قاعدةالبيانات المصدر الذي سيتم البحث فيه myArray = DATA.Range("A7:EF" & lr) '____________________________________________ 'عدد الاعمده في الجدول في صفحه الهدف ReDim Y(1 To lr, 1 To 13) For X = 1 To lr - 6 If targt = "" Then Exit Sub 'رقم عمود معيار البحث If myArray(X, 101) Like targt & "*" Then rw = rw + 1 'For ww = 1 To 102 ' Y(rw, ww) = myArray(X, ww) ' Next ww 'العمود التاني بعد المسلسل Y(rw, 1) = myArray(X, 2) 'العمود الثالث بعد المسلسل Y(rw, 2) = myArray(X, 3) 'العمود الرابع بعد المسلسل Y(rw, 3) = myArray(X, 13) 'العمود الخامس بعد المسلسل Y(rw, 4) = myArray(X, 22) 'العمود السادس بعد المسلسل وهكذا Y(rw, 5) = myArray(X, 31) Y(rw, 6) = myArray(X, 40) Y(rw, 7) = myArray(X, 51) Y(rw, 8) = myArray(X, 52) Y(rw, 9) = myArray(X, 82) Y(rw, 10) = myArray(X, 101) Y(rw, 11) = myArray(X, 102) ' Y(rw, 12) = myArray(X, 110) ' Y(rw, 13) = myArray(X, 111) End If Next X If rw > 0 Then SERCH.Cells(Rows.Count, 3).End(xlUp)(2, 1).Resize(rw, 13).Value = Y() End Sub ترحيل الدور التاني5.rar

ترحيل بيانات بالقائمة المنسدلة للعلامه عبد الله باقشير ترحيل عن طريق القائمة المنسدله.rar

اخي ابو جمال هل هذا هو المقصود الاخفاء.rar

الموضوع في غاية البساطة، وهو كالتالي: 1- من قائمة أدوات>ماكرو / إختر "تسجيل ماكرو جديد...". 2- سيظهر لك مربع حوار يخبرك باسم الماكرو ووصفه أنقر "موافق". وبذلك سيقوم محرر الفيجوال بيسيك بتسجيل كل ما تقوم به في برنامج الإكسيل داخل مديول خاص(Module1) ويطلق عليه اسم ماكرو1 أو Macro1 أو الاسم الذي تحدده انت من مربع الحوار السابق. 3- من قائمة أدوات>ماكرو / إختر "محرر Visual Basic". 4- سيظهر أمامك محرر الفجيوال بيسك أنقر نقراً مزدوجاً على المديول "Module1" في شجرة المشروع الحالي "Project VBAProject" بأعلى اليسار. وبذلك سيظهر أمامك الماكرو الذي يترجم كل تحركاتك وأفعالك داخل البرنامج إلى أكواد. ومن هنا تكون نقطة الإنطلاق إلى عالم أكواد الفيجوال بيسيك. وكيف يكون ذلك؟ قم بتصغير شاشة محرر الفيجوال بيسيك لتذهب للكتاب الحالي ثم قم بأي عمل تريده، على سبيل المثال: حدد الخلية B5 ثم إذهب للمحرر ستجد أنه ترجم عملية التحديد هذه إلى الكود التالي: Range("B5").Select ثم تذهب مرة أخرى للكتاب ثم تكتب في الخلية "الله أكبر" ستجد أنه ترجم هذه التصرف للكود التالي: ActiveCell.FormulaR1C1 = "الله أكبر" وهكذا.... فبنظرك ومقارنتك للذي تفعله والذي يكتب داخل الماكرو سوف تتعلم طريقة كتابة الأكواد ليس داخل برنامج الإكسيل فقط بل في تطبيقلت فيجوال بيسيك عموماً. وأخيراً أتمنى أن أكون قد وفقت في إيصال المعلومة. وأي سؤال أنا جاهز. أخوكم أكرم الغامدي (أبو عبدالله).