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

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

أساتذتي الافاضل @essam rabea و @ابو ياسين المشولي و @sandanet و @ابا جودى كنت قد بدائت بعمل ملف ارفع للمنتدى حتى يتسنى لكم التعديل علية لحل المشكلة حذفت اغلب النماذج والتقارير من الملف الاساسي وأبقيت على نماذج الواجهة فقط الذي فيها المشكلة فقمت بعمل اخير وهو تجربته في جهاز اخر وهنا المفاجئة اشتغل تمام أدركت حينها أن في قيمة حقل او قد ربما كود هو المسبب وبعد الفحص في الملف الاساسي .. اكتشفت سبب المشكلة وهو كود تحت زر فتح نموذج تغيير كلمة السر On Error GoTo Err_Orders1_Click Form_Main!F8.SetFocus Form_Main.F8.BackColor = RGB(33, 150, 243) Form_Main.F8.ForeColor = RGB(250, 250, 250) Dim x As Integer x = DLookup("SN", "users_T", "deCode([UName],'User')='" & Trim(MyUser.USERNAME) & "'") DoCmd.OpenForm "UsersChangePassword_F", , , , , acDialog, x Exit_Orders1_Click: Exit Sub Err_Orders1_Click: MsgBox Err.Description Resume Exit_Orders1_Click قمت بألغاء هذا الكود On Error GoTo Err_Orders1_Click ' ' Exit_Orders1_Click: Exit Sub Err_Orders1_Click: MsgBox Err.Description Resume Exit_Orders1_Click وتم فتح البرنامج بشكل طبيعي أشكركم على سعة صدوركم و وتعاونكم معي فجزاكم الله عني خيرا

بالنسبة للترحيل من ملف لاخر هناك زر ترحيل في شيت1 بالملف الاول اما الترحيل الى الشيتات الاخرى يجب عليك انشاء الصفحات كما تريد وضع بعض البيانات فيها كنمودج نهائي للعمل وارفعه مع شرح المراد في المرفق فك الضغط ستجد مجلد "my_test"ضعه كما هو في اي فولدر تريد my_test.rar

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

شرُف منتدانا بانضمامكم لمجموعة الخبراء زادكم الله علما ونفع بكم

حياك الله أخي محمد ضع هذا الكود في حدث عند الإغلاق StopSound Me.SoundPath وبالتوفيق

السلام عليكم امتداداً لتطويرات برنامج الخليل المحاسبي يسرني أهدي لكم الإصدار الثاني مع تعديلات وإضافات جميلة كما أشكر أستاذي الفاضل @sandanet لقد استفدت من طريقته في الحماية حسب مشاركته القيمة : اترك لكم البرنامج . وآملاً أن اتلقى ملاحظاتكم القيمة بعد استخدام البرنامج . تقبلوا فائق المحبة والتقدير BuySal20_V14.accdb BuySal20_V14.accdb.mdb.zip

السلام عليكم ورحمة الله وبركاته.. آولآ نقُوم بتَسجيل عضُوية بمُوقع [ PasteBin ] رآبط آلتَسجيل [ هُنآ ] آتمآم آلتَسجيل ، ظهُور رسآلة تُخبرك بآلتُوجه نحُو بَريدك لتَفعيل آلعضُوية بَعد عَملية آلتَفعيل ظهُور رسآلة تُخبرك بنجآح آلتَفعيل آلآن نقُوم بتَسجيل آلدخُول قم باعطاء هذا الملف الى العميل لكي يظهر لك الرقم الخاص به ثم يقوم العميل بإعطائك هذا الرقم، بعدها ستقوم انت باضافته الى المفكرة التي انشأتها في موقع pastebin ثُم نقُوم بآلضَغط عَلى كَلك يَمين عَلى كَلمة [ RAW ] ونَختآر ارجع الى برنامجك, وقم بإلصاق الرابط في المكان المخصص له Option Compare Database Private Sub Form_Current() Dim HDD, PID, MB, MAC As String PID = ProcessorId() HDD = VolumeSerialNumber() MAC = MACAddress() MB = MotherBoardID() Dim PHMB As String PHMB = Strings.UCase(MD5Hex(PID & HDD & MB & MAC)) On Error Resume Next Dim objHttp As Object Set objHttp = CreateObject("MSXML2.ServerXMLHTTP") Call objHttp.Open("GET", "ضع الرابط هنا", False) Call objHttp.Send("") For Each c In Split(objHttp.ResponseText, "|") If PHMB = c Then GoTo authed End If Next MsgBox "1 - قد تكون النسخة الحالية غير مسجلة" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "2 - تأكد من اتصالك بالانترنت" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "3 - اذا لم تكن واحدة من تلك المشاكل قم بالاتصال بالمبرمج" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "www.facebook.com/Nisr.Aln3jaf", vbCritical, "ERROR" DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit Exit Sub authed: MsgBox "تم تفعيل النسخة بنجاح" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "شكرا لإستخدامك هذه النسخة", vbInformation, "عملية ناجحة" End Sub Public Function MD5Hex(textString As String) As String Dim enc Dim textBytes() As Byte Dim bytes Dim outstr As String Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider") textBytes = textString bytes = enc.ComputeHash_2((textBytes)) For pos = 1 To LenB(bytes) outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2)) Next MD5Hex = outstr Set enc = Nothing End Function Public Function MACAddress() On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration", , 48) For Each objItem In colItems MACAddress = objItem.MACAddress Next End Function Public Function ProcessorId() On Error Resume Next Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor") For Each objItem In colItems ProcessorId = objItem.ProcessorId Next End Function Public Function VolumeSerialNumber() As String On Error Resume Next Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set oItems = oWMI.ExecQuery("Select * from Win32_DiskDrive") For Each oItem In oItems VolumeSerialNumber = oItem.SerialNumber Next End Function Public Function MotherBoardID() As String On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_BaseBoard", , 48) For Each objItem In colItems MotherBoardID = objItem.SerialNumber Next End Function في كل قواعد البيانات التي تريد حمايتها ضع نفس الرابط، لا تقم بإنشاء مفكرة جديدة في موقع pastebin آلآن آلسؤآل كَيف سآقُوم بآضآفة آكثر مَن رَقم عَميل بنفس المفكرة ؟ آلجوُآب بَين كُل عَميل وآخر آفصل بَينهم بآلـ [ | ] مثآل بَسيط عَلى آلعَملية .. تم بحمد الله ، SEMO.Pa3x GET_INFO.accdb Protection.accdb

السلام عليكم 🙂 هذا المنتدى ولله الحمد ، به الخير الكثير ، والخبراء يسطعون بعطائهم مميزين بعطائهم 🙂 اخي الكريم @ابوآمنة ومحمد البرناوي @Barna ، لنا الشرف انظمامكم لفريق الخبراء 🙂 ولازلنا نبحث بين الاجابات على المتميزين 🙂 جعفر

وعليكم السلام 🙂 شكرا لك اخوي ابو زاهر ، ليس بصفتي عضو في فريق الموقع فقط ، وانما بصفتي العضو جعفر ايضا 🙂 مكان رائع نجتمع فيه ، حُباً في خدمة بعضنا البعض 🙂 جعفر

تفضل اخوي ابو ياسين ، فالموضوع تابع للسؤال 🙂 وشكرا لك على مراعاة قوانين المنتدى 🙂 جعفر

بعد إذن والدى الحبيب واستاذى الجليل ومعلمى القدير الاستاذى @jjafferr اسمح لى اقوم بارفاق هذا التعديل على المرفق لاخى صاحب المسألة - انشاء الـ QR Code لكل سجل على حده فى النموذج المستمر -عرض الـ QR Code الذى تم انشاءه لكل سجل على حدة داخل النموذج المستمر -عرض تقرير لكل سجل على حده فى من خلال السجل الحالى داخل النموذج المستمر -عرض تقرير مجمع لكل السجلات فقط التى تم انشاء الـ QR Code لها فقط اتفضل يا استاذ @nasseam1969 سؤال.zip

الحمد لله

تفضل تم تغيير معادلتك نهائياً فهى لا تعمل المشتريات1.xlsx

السلام عليكم ورحمة الله تم عمل المطلوب في الملف المرفق... test 1.xlsx

اخي محي الدين اظن انه لا حاجة للأمر Select عدة مرات مما يرهق البرنامج دون فائدة ولا حاجة للحلقة التكرارية مرة ثانية لاستخراج Items من Dictionary يكفي وضع هذا السطر ما بين علامات الــــ +++ Sub test() Dim a As Variant, lr, i lr = Cells(Rows.Count, 2).End(xlUp).Row a = Range("b3:b" & Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 6) Cells(3, "H").Resize(100).ClearContents With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If a(i, 1) <> 0 Then If Not .exists(a(i, 1)) Then .Add a(i, 1), a(i, 5) Else .Item(a(i, 1)) = .Item(a(i, 1)) & "-" & a(i, 5) End If End If Next '+++++++++++++++++++++++++++++++++++++++ Cells(3, "H").Resize(.Count) = Application.Transpose(.items) '++++++++++++++++++++++++++++++++++++++++ End With End Sub

Sub test() Dim a As Variant, lr, i lr = Cells(Rows.Count, 2).End(xlUp).Row a = Range("b3:b" & Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 6) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If a(i, 1) <> 0 Then If Not .exists(a(i, 1)) Then .Add a(i, 1), a(i, 5) Else .Item(a(i, 1)) = .Item(a(i, 1)) & "-" & a(i, 5) End If End If Next For i = 1 To lr - 2 Cells(2 + i, 2).Offset(, 6).Select Cells(2 + i, 2).Offset(, 6) = .Item(Cells(2 + i, 2).Value) Next End With End Sub

فورم التنقل عبر الصفحات وترحيل البيانات بطريقة بسيطة الفيديو

السلام عليكم ورحمة الله تعالى وبركاته اتمنى ان تكونو بصحة جيدة الموضوع ببساطة هو التحكم بقاعدة البيانات اونلاين ( قفل & فتح ) الشرح جعلت قاعدة البيانات تقرأ بيانات التفعيل اونلاين لا تقلقو لن نحتاج الى استضافة او ما شابه فقط ملف نصى به بيانات التفعيل بيانات التفعيل كالتالى حالة الترخيص ك منتهى او نشط الرسالة : احددها كما اشاء اكتب بها ما اريد ان اخبر به العميل الترخيص من الفترة كذا الى الفترة كذا طبعا يا جماعة الموضوع مشاركة لافكاركم فى هذا المجال حتى ننميه انا مش هنزل الاكواد الا لما تعصورو دماغكم من التفكير وتقولولى نستغل الموضوع دا ازاى طبعا من مميزات الموضوع دا اننا هنتحكم بقاعدة البيانات تفتح عن العميل او لا بدون كود تفعيل بقى او وقت محدد كل دا انا اللى هحدده مثلا ممكن نعمل قاعدة بيانات تانية تتحكم فى ملفات التكست اللى عندك كمبرمج الخاصة بكل نسخة من البرامج اللى ابيعها يعنى قاعدة البيانات دى هسجل فيها كل البيانات الخاصة بتفعيل البرامج اللى ابيعها وهى تعرفنى بقى البرامج اللى قربت تنتهى والبرامج اللى عاوزة تتفعل وهكذا بجد شاركونا بافكاركم وانا ان شاء الله هنزل قواعد البيانات مفتوحة المصدر اغلاق وفتح اونلاين ACCDE.rar اغلاق وفتح اونلاينMDB.rar

فورم ترحيل بيانات للشيت المطلوب عن طريق الMultiPage الفيديو

شعور متبادل بيننا😍 ونحن نحبكم في الله جميعاً

لك ما تريد maktaba_2.xls

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

الرابط اللي اعطيتك ، فيه مرفق للاستاذ ابا جودي ، وفيه نموذج ، وفي النموذج زر لطباعة جميع السجلات : . وهذه نتيجة التقرير : جعفر

الحمد لله الذى بنعمته تتم الصالحات

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

وانا كذلك

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

الاخوة @Barna و @ابوآمنة مبروك الشارة وبالتوفيق إن شاء الله

مبارك للاخوة الافاضل اللهم ربي يحفظهم ويحفظ الجميع يارب

ايه يا باشا ، انتو سنتكم غير عننا وإلا ايه جعفر

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

فورم تغيير لغة الكتابة فى التكست بوكس للغة المطلوبة فورا والبحث باى لغة فيديو 2 الفيديو

ما شاء الله لا قوة الا بالله جزاك الله خيرا على هذه الهدية القيمة دمتم بالخيرات تحياتي

السلام عليكم ورحمة الله وبركاتة استاذنا المحترم بن علية حاجي جزاك الله خيراً وبارك الله بعلمك الملف اكثر من رائع وكما تعودنا دائما من خلال منتدانا المتميز بوجود نخبة كبيرة من خبراء ومبدعي الاكسيل نجد دائماً حل لجميع تساؤلاتنا استاذي الفاضل تقبل تحياتي

استاذ حسنين بارك الله فيك أولاً على هذا الشرح .. طريقتك جديدة وجميلة لكن هنالك نقاط اود ان استفسر عليها وهي: 1- ماذا لو قام المستخدم بتغيير نظام تشغيله هل يتوجب عليه ارسال الرقم للمبرمج مرة أخرى؟ 2- ماذا لو قام المستخدم بنقل البرنامج بعد تفعيله الى جهاز آخر فهل سيعمل ويكون مفعلاً ايضاً ام يطلب منه التفعيل مجدداً ؟ 3- هل الطريقة هذه تتطلب اتصال الجهاز بالانترنت لإجراء عملية التفعيل فقط أم يتطلب اتصال دائم؟ 4- ماذا لو تم إغلاق الموقع لأي سبب كان؟ 5- على ماذا تعتمد فكرة الحماية؟ طبعاً هذه الأسئلة أود معرفة اجابتها قبل تجريب البرنامج لو سمحت تحياتي

أخي العزيز سليم كلامك صحيح مشكور

@Barna و @ابوآمنة ما شاء الله تبارك الله ...... تستاهلون هذه المنزلة ....موفقين دائما للخير ...

@Barnaأخوىَّ الحبيبان .. @ابوآمنة مبارك إنضمامكم لخبراء أوفيسنا .. شرُفنا بكما وفقكم الله وأعانكم على الخير

مبارك عليكما اللقب @ابوآمنة ومحمد البرناوي @Barna وفقكم الله الى كل خير .. وجعلكما ذخراً للأسلام والمسلمين

سبقتنى كنت اجهز لموضوع مماثل التفعيل عن طريق الانترنت وبما ان الطرق مختلفة ساكمل فى طريقى واجهز الموضوع هههههههههههههههههه بارك الله فيك متميز دائما

كعادتي اليومي اطلع على أبرز المواضيع ، فتفاجأت بأن لقبي أصبح خبيراً 😅 والأعضاء يرحبوا بي ولزميلي @Barna فبهذه المناسبة أتقدم بجزيل الشكر والتقدير إلى إدارة منتدانا الغالي الذي منحنا فرص لخدمة الناس كما قال الرسول صلى الله عليه وسلم (أحبُّ الناسِ إلى اللهِ أنْفَعُهُمْ لِلنَّاسِ ) . أيضاً أخص بالشكر أفضله وأحسنه لأستاذنا ومعلمنا الجليل♥️ @jjafferr وللأعضاء الكرام وأبارك لزميلي الفاضل @Barna أسأل الله تعالى العلي القدير أن يعيننا على تحمل المسؤولية . وبارك الله فيكم وسدد خطاكم ..

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

الف مبروك والى الامام دائما باذن الله 🌷

الف مليون مبروك لاخواننا الافاضل والى مزيد من التقدم وبالنوفيق للجميع تحياتي

اخي الكريم @ابوآمنة ومحمد البرناوي @Barna مبارك لكما هذا اللقب ... وانتم تستحقون ذلك اسأل الله لكما التوفيق والاعانة

مبارك للأخوة مع الدعاء بدوام التوفيق للجميع

السلام عليكم الاخ الكريم / ابو الوفا سيد سليم هذه اول مشاركة لك في منتدانا الرائع .. الجميع هنا اخوة في الله .. وبان شاء الله ماتحتاجه بالضبط ستجده هنا باذن اله مع الاساتذة والخبراء وباقي الاعضاء ... فاهلا ومرحبا بك بين اخوانك في هذا الصرح العملاق ==================== بالنسبه لطلبك : ( سيتم الشرح علي الكود الخاص بك حيث انه خاص بالمعاينه وليس الطباعه ) ؟؟؟؟؟ هل الاوراق التي تقصدها في شيت واحد أي ( صفحه 1 - صفحه 2 - صفحه 3 - .... الخ ) يكون الكود الكتالي ( بتغيير المدي المحدد من قبلكم في أكثر من سطر في الكود ) ( لطباعة أكثر من مدي في نفس الصفحة sub طباعة() Sheet1.Range("a1:g29").PrintPreview Sheet1.Range("a30:g60").PrintPreview Sheet1.Range("a61:g90").PrintPreview End sub اما اذا كانت اوراق عمل مختلفة يتم تغيير اسم الشيت في البداية ليكون الكود كالتالي sub طباعة() Sheet1.Range("a1:g29").PrintPreview Sheet2.Range("a1:g29").PrintPreview Sheet3.Range("a1:g29").PrintPreview End sub وكما اخبرت حضرتك بان الكود المرسل منك خاص بالمعاينه فان اردت تغييره للطباعه المباشرة قم بتغيير .PrintPreview الي .PrintOut ارجو ان اكون قد وفقت في تنفيذ طلبك واي توضيح الجميع هنا في خدمه بعضهم البعض

الف شكر اخ احمد غانم

أقول باختصار: أنت كنز عظيم للموقع اخي @jjafferr وبارك الله فيك وزادك الله من فضله