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

السلام عليكم ورحمة الله استخدم هذه الدالة المعرفة Function Repeat_Int(Rng As Range) For i = 1 To Len(Rng) If IsNumeric(Rng) Then If Mid(Rng, i, 1) = 1 Then p = p + 1 End If End If Next Repeat_Int = p End Function

ببارك للأخ وجيه شرف الدين الترقية لدرجة الخبراء😄 باذن الله ستكون هناك ترقيات أخرى قريبا فى القسم 😃

يمكن تعبئة الخلايا الفارغة بدون (Sort) ابجدياً بواسطة هذا الماكرو Option Explicit Sub give_Data() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim last_ro# last_ro = Range("a1").CurrentRegion.Rows.Count Range("MM2").Resize(last_ro - 1).Formula = _ "=IF(AND(C2<>"""",D2<>""""),D2,INDEX($D$2:$D$" & last_ro & ",MATCH(C2,$C$2:$C$" & last_ro & ",0))" & ")" Range("D2").Resize(last_ro - 1).Value = _ Range("MM2").Resize(last_ro - 1).Value Range("MM2").Resize(last_ro - 1) = vbNullString With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف مرفق FiLL_Empty.xlsm

بارك الله فيك استاذنا الكريم محمد طاهر وهذا بالطبع يسعدنى ويشرفنى ويارب اكون جدير بهذه الثقة الكبيرة واكون ان شاء الله عند حسن ظنكم بى-وشاكر جدا لصرحنا الكبير بما فيه من مديرين ومشرفين وخبراء جزاكم الله جميعا خير الثواب

السلام عليكم يسعدنا انضمام الأخ على محمد على الي فريق الموقع أعانك الله على المسؤولية الجديدة 😃

السلام عليكم طلبك اخي الكريم بسيط وممكن عمله بكل سهولة ----ولكن هل تعلم ما سيصبح حجم قاعدة البيانات بعد استعمالها لفترة قصيرة من الزمن اما اذا طالت فحدث ولا حرج خصوصا انت تطلب اظهار جميع التعديلات والمعلومه السابقة والاحقه (وما بالك اذا اجري اكثر من تعديل على سجل واحد او عدد من السجلات) بعدها ستبداء المشاكل لكبر حجم قاعدة البيانات هناك حلول ابسط من الذي طرحت 1 - صلاحيات المستخدمين --- اعطاء صلاحيات التعديل والحذف والاضافة لعدد محد من الاشخاص او حصرها بالمدير او بمسؤول محدد (وهي الافضل ) 2 - استخدام النسخ الاحتياطي --- وعمل حقلين اضافين في الجدول الرئيسي لمعرفة وقت اخر عملية تعديل ومقارنتها بالنسخه الاحتياطية (وهذه عملية اكثر تعقيد ) يالتوفيق

كيفية عمل خطوط كوفى فى الاكسل الفيديو الصور [hide]رابط الملف[/hide]

السلام عليكم ورحمة الله تم عمل معادلات النطاقات المطاطية باستعمال الدالة OFFSET (بالفرنسية DECALER) على أساس أن قائمة معلمي كل مادة متسلسلة (الأسماء كلها تحت بعض)... أرجو أن تفي الغرض المطلوب... بن علية حاجي النطاقات.xlsx

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

بعد إذن الأستاذ / وجيه جرب هذا لعله يكون المطلوب وهو عبارة إنشاء قائمة منسدلة تعتمد على قائمة منسدلة أخرى النطاقات.xlsx

بعد اذن اخي ابراهيم جرب هذا الملف (يمكن استخراج اي شيء) ليس فقط الارقام HOW_MANY.xlsm

ألف مبروك للأستاذ الفاضل / علي وأدعوا الله أن يعينه على مسئولية هذا المنصب

السلام عليكم 🙂 اللغة العربية هي المطلوبة هنا 🙂 المرفق المضغوط فيه مجلد وبرنامج اكسس ، والبرنامج اللي يعمل لنا QR code الموجود على الرابط التالي: https://sourceforge.net/projects/zint/ ويتم حفظ الصورة هنا Data > QR_images وعلشان كل شيء يشتغل تمام ، رجاء لا تعمل تغيير في مكان الملفات ولا المجلدات ، ولا تغيير اسمائها (طبعا تقدر تعمل اللي تريد ، بس على اساسه يجب تغيير الكود كذلك) وهي النتيجة: وخلونا نشوف من يقدر يقرأ الصورة 🙂 ----------------------------------------------------------------------------- إضافة في يوم الثلاثاء 7 / 5 / 2019 : عملت مثال يعمل على 2003 🙂 ----------------------------------------------------------------------------- إضافة في يوم الجمعة 14 / 6 / 2019 : باركود بطاقة دخول الطائرة (Boarding card) وهي من نوع PDF417 اختار الحقول اللي تريدها تظهر في QR code بإختيار مربع صح/خطأ : . والنتيجة: . و باركود 128 (ويمكن عمل اي نوع من انواع الباركود) . والتقرير (وبعد اذن اخي محمد سلامه ، فقد استعملت الصورة التي استعملها في مثاله 🙂 ) . وبهذه الطريقة نرى اننا لا نحتاج ان نحفظ صورة لكل سجل (واذا اردنا ذلك ، فنعمل تعديل في الكود ليقوم بذلك). وهذا الكود مضافا اليه عمل الباركود العادي : Private Sub Make_QR_Barcode() ' 'https://sourceforge.net/projects/zint/ ' If Len(Me.str_Text & "") = 0 Then Exit Sub Dim App_Name As String Dim Output_File As String Dim Output_Text As String Dim Encoding As String Dim Command_Line As String App_Name = Chr(34) & Application.CurrentProject.Path & "\Data\zint.exe" & Chr(34) Output_Text = Chr(34) & Me.str_Text & Chr(34) 'QR code Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "QR_code.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --scale=2 -w 10 --height=100 --barcode=58 -d " & Output_Text 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide 'Barcode 128 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "Barcode.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 -d " & Me.ID 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide 'PDF 417 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "PDF_417.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --binary --barcode=55 --mode=3 -d " & Output_Text 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide End Sub ----------------------------------------------------------------------------- إضافة في يوم الجمعة 22 / 6 / 2019 : تم عمل VCard QR ليخزن معلومات الشخص مباشرة في الموبايل 🙂 . وبإستخدام برامج الموبايل والتي تقرأ QR Code ، يمكنك حفظ معلومات VCard QR مباشرة في عناوين الموبايل 🙂 البرنامج zint الموجود في المرفق ، فيه امكانية عمل عدة انواع من QR والباركودات ، ولكن كل نوع من هذه الانواع له صيغة خاصة في عمله ، فمثلا كود VCArd QR هو: Function Add_Items() Dim VCard_Text As String 'clear field VCard_Text = "" VCard_Text = "BEGIN:VCARD" & vbCrLf VCard_Text = VCard_Text & "VERSION:3.0" & vbCrLf VCard_Text = VCard_Text & "N:" & Me.[Family Name] & ";" & Me.[Given Name] & ";" & Me.[Additional Name] & ";" & Me.[Name Prefix] & ";" & vbCrLf VCard_Text = VCard_Text & "FN:" & Me![Name] & vbCrLf VCard_Text = VCard_Text & "ORG:" & Me.[Organization 1] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 1 - Type] & ",VOICE:" & Me.[Phone 1 - Value] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 2 - Type] & ",VOICE:" & Me.[Phone 2 - Value] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 3 - Type] & ",VOICE:" & Me.[Phone 3 - Value] & vbCrLf VCard_Text = VCard_Text & "ADR;:" & ";;" & Me.[Address 1] & ";;;;" & vbCrLf VCard_Text = VCard_Text & "BDAY:" & Me.[Birthday] & vbCrLf VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 1 - Type] & ":" & Me.[E-mail 1 - Value] & vbCrLf VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 2 - Type] & ":" & Me.[E-mail 2 - Value] & vbCrLf VCard_Text = VCard_Text & "NOTE:" & Me.Notes & vbCrLf VCard_Text = VCard_Text & "URL:" & Me.[Website 1] & vbCrLf VCard_Text = VCard_Text & "END:VCARD" Add_Items = VCard_Text End Function والذي يختلف عن PDF417 والذي يختلف عن غيره. المرفق في ملفين بصيغة txt والذي فيهما جميع الاوامر التي يمكن استعمالها لعمل مختلف انواع الباركود 🙂 ----------------------------------------------------------------------------- إضافة في يوم السبت 2 / 11 / 2019 : هنا مثال لعمل بطاقة عمل ID.zip ، بأصغر حجم QR code (رجاء ابقاء حجمه ، فقد توصلت الى هذا الحجم والكود بعد محاولات ساعات طويلة) : . وهذا هو QR code . اما تفاصيل عمل البطاقات ، فهذا الرابط فيه تفاصيل كاملة: . جعفر ملاحظة: 1. المرفق في هذه المشاركة هو البرنامج الاخير ، وفيه جميع التعديلات التي في بقية المشاركات. 2. الـ api التي تنتظر إنتهاء الامر ، ثم تنتقل للسطر التالي في الكود اسمها ShellWait ، هذه لا تتعامل مع Unicode / utf-8 / ومنها الحروف العربية بطريقة صحيحة : http://access.mvps.org/access/api/api0004.htm بينما هذه تمام : https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas zint QR 3.zip ID.zip Shell_n_Wait_2021-12-13.txt.zip

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

اسم المستخدم admin1 كلمة المرور 1123 رابط التحميل

السلام عليكم ارفق بالمثال نموذج الادخال الرئيسي كي يتم التعديل عليه بالتوفيق

بارك الله فيك استاذى الكريم وجزاك الله كل خير

الف مبروك اخي على ... تستاهل كل خير يا محترم

تسلم الأنامل

فقط استبدل الجزء هذا بمكان الحفظ C:\Documents and Settings\ahmed\Desktop\New Folder (2) ولمعرفة المكان الذي تريد الحفظ فيه فمثلاً عند فتح مجلد التنزيلات نلاحظ في الصورة

من أول نظرة الى الملف لاجظت ان تتابع الأسماء المكررة لذلك اقترحت هذا الماكرو اذا لم تكن الأسماء المكررة متتابعة بجب اولا ترتيبها (Sort) ابجدياً ثم ينفذ الماكرو

دائما مبدع استاذنا الكريم سليم ولكن عند تجربة الكود يأتى بالبيانات صحيحة فى حالة تتابع الأسماء المكررة ولكن اذا كانت الأسماء المكررة متباعدة ومتفرقة فيأتى ببيانات خاطئة

جرب هذا الماكرو Sub SALIM_MACRO() On Error Resume Next Columns("D:D").SpecialCells(4) _ .FormulaR1C1 = "=R[-1]C" '4 =====> xlCellTypeBlanks On Error GoTo 0 End Sub

اتففضل New Microsoft Access قاعدة بيانات.accdb

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

بارك الله فيك استاذ موسى وشكرا جدا على هذا البرنامج الرائع ,ولكى تعم الفائدة فبعد اذنك طبعا سأقوم برفعه داخل المنتدى البيان_للمحاسبة.xlsm

تفضل .. ضع في مجلد الصور صورة تحمل الاسم : 0 On Error GoTo ErrHandler Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acCommandButton Then If Not IsNull(ctl) And ctl.Tag <> "" Then ctl.Picture = PicBt & ctl.Tag & ".bmp" End If End If ReHandler: Next ctl Exit Sub ErrHandler: If Err.Number = 2220 Then ctl.Picture = PicBt & "0.bmp" Resume ReHandler End If

الف مبروك على هذا التكليف وليس التشريف لانه مسؤلية كبيرة ربنا يوفقك يارب تقبل تحياتى واحترامى ونقديرى صوت الحق

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

السلام عليكم ورحمة الله اخى الكريم على قبل ان اتوجه بالتهنئة لك اتوجه بالتهنئة للموقع و اعضاء الموقع فالمكسب الاكبر لمنتدانا الحبيب الف الف مليون مبروك .... عن جدارة و استحقاق

يمكن عمل تصفية للمادة بدون تسمية أي نطاقات النطاقات(1).xlsx

بارك الله فيكم جميعا وجزاكم الله جميعا كل خير وكل عام وانتم بخير وشكرا على ثقتكم بى

جرب هذا الملف لعله يفى بالغرض نسخة من النطاقات-1.xlsm

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

الاخ وجيه نشاطك ممتاز هذه الفترة وتستحق الترقية بالتوفيق ان شاء الله ولى قصة فى بنها احكيها لك على الفيس فكرنى

الف مبروك للأستاذ وجيه ترقية مستحقة ان شاء الله ربنا يوفقه

جزاكم الله اخوانى الاحباء عن هذا الشعور الطيب والنبيل والف شكر على هذا التقدير وهذا شرف لى الف شكر استاذ سليم الف شكر استاذ احمد بدره الف شكر استاذ على الف شكر استاذ اهلاوى الف شكر استاذ ابراهيم الحداد الف شكر استاذ محمد طاهر وان شاء اكون عند حسن ظن الجميع

الف مبروك ومن تقدم الى تقدم ترقية مستحقة ان شاء الله

الاخ لم ينزل مرفق حتى نفحص تمام ابا خليل ومسالة تقديم الدالة هنا او تاخيرها فانا اتحدى الاخ اذا كان حل المشكلة بتبديلها وهنا : - الاخ لم ينزل لو مرفق به الجدول والتقرير فقط وكما طلبو الاساتذه اعلاه - الاخ لم يذكر نوع بيانات الحقل في الجدول - شلون ظبطت في النموذج ولم تظبط في التقرير !! - حتى الصورة الاخيره اعطانا المعادلة وبدون صورة للنتيجة اخيرا : نفس الشي "قرب ثم اجمع" "اجمع ثم قرب " والاصح زي ماقلت انت ابا خليل اجمع ثم قرب وهو الادق محاسبيا فلو قربت اولا ملايين الاعداد حتما ستحصل على مجموع ليس دقيق جدا تحياتي

وعليك السلام ورحمة الله وبركاته تم عمل المطلوب وبالنسبة للطباعة بنوع pdf يكفي أمر واحد وتم عمل كود للحفظ على سطح المكتب تفضل الملف 2202.xlsm

ألف مبروك وأتمنى من الله مزيدًا من التقدم

الف مبروك للأستاذ وجيه ترقية مستحقة ان شاء الله

الف مبروك ومن تقدم الى تقدم

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

بجد ولكن وعلى فكرة الفاكهة اللى حضرتك خدتها دى لسه ما ادفعش تمنها

الشيت ثقيل لانك تجعل الكود ينتظر ثانية واحدة في كل خطوة من خلال الدالة Wait ما مجموعه (55 × 57 =4125 ثانية اي حوالي ساعة وربع) جرب هذا الماكرو Sub salama() Application.ScreenUpdating = False Dim My_num, i#, col# Dim color_index% color_index = 1 + 18 * Rnd() For i = 3 To 55 For col = 2 To 57 Select Case Cells(i, col) Case 1: My_num = 2 Case 2: My_num = 3 Case 3: My_num = 1 Case Else: My_num = "" End Select Cells(i, col) = My_num Cells(i, col).Interior.colorindex = color_index Next Next Application.ScreenUpdating = True End Sub '=================================== 'هذا الكود للتصحيح في حال ادخال رقم مختلف بالخطأ Sub reset() Application.ScreenUpdating = False Dim i#, col# For i = 3 To 55 For col = 2 To 57 If Cells(i, col) <> vbNullString Then _ Cells(i, col) = 1 Next Next Application.ScreenUpdating = True End Sub 2030.xlsm

تفضل رصد الدرجات1.xlsm

السلام عليكم ورحمة الله لست أدري إن كنت قد فهمت المطلوب جيدا وهذه محاولة في الملف المرفق... بن علية حاجي الفرز الطرفي.xlsx

السلام عليكم ورحمة الله استخدم هذه المعادالة و لا تنسى الضغط على Ctrl+Shift+Enter =INDEX(الموقف!$B$2:$F$3;MATCH((E2&D2);الموقف!$B$2:$B$3&الموقف!$D$2:$D$3;0);5)