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

تفضل اخي الكريم Dim mySQL As String mySQL = "SELECT TOP 4 * FROM Table1" mySQL = mySQL & " ORDER BY num DESC;" Me.RecordSource = mySQL Me.Requery test(2)(1).accdb تحياتي

تفضل لك ما طلبت على الرغم انى افضل العمل على ملف الإكسيل مباشرة دون العمل على الفورم Followup patients.xlsm

السلام عليكم 🙂 بالاضافة الى ميزات الاكسس الشخصية ، فيه امكانية مخاطبة البرامج الاخرى بعدة طرق ، احدها عن طريق Command line ، بحيث يمكننا ان نرسل اوامر من الاكسس الى هذا البرنامج الذي يقبل الاوامر من Command line . البرنامج pdftk (في المرفق) احد هذه البرامج : https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/ المرفق فيه برنامج اكسس وملف a.pdf و b.pdf ، وبزر من الاكسس ، سيتم دمج الملفين الى ملف ab.pdf ، وفي المرفق ملف الاوامر التي يقبلها برنامج pdftk . البرنامج يستطيع التعامل مع ملفات pdf بعدة طرق ، لذلك وجب قراءة ملف الاوامر 🙂 وهذا هو الكود: Private Sub cmd_combine_Click() 'Merge Two or More PDFs into a New Document 'pdftk 1.pdf 2.pdf 3.pdf cat output 123.pdf Dim pdftk_File As String Dim a_FILE As String Dim b_FILE As String Dim ab_FILE As String Dim Command_Line As String pdftk_File = Chr(34) & Application.CurrentProject.Path & "\" & "pdftk" & Chr(34) a_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "a.pdf" & Chr(34) b_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "b.pdf" & Chr(34) ab_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "ab.pdf" & Chr(34) Command_Line = pdftk_File & " " Command_Line = Command_Line & a_FILE & " " Command_Line = Command_Line & b_FILE & " " Command_Line = Command_Line & "cat output" & " " Command_Line = Command_Line & ab_FILE 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide End Sub جعفر اعتقد عندي هذا الملف من سنة 2009 --------------------------------------------------------------- تعديل 31-10-2019 : - استخدام الوحدة النمطية Shell_n_Wait والتي تقبل حروف unicode - utf-8 ، من https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas http://www.vbforums.com/showthread.php?700373-VB6-Shell-amp-Wait&p=4288285&viewfull=1#post4288285 - تم تغليف مسار الملفات بالاشارة " ، وذلك لحل مشكلة وجود مسافات في اسم المسار او الملف ، - تم تفكيك خط الامر الى مكونات اصغر ، لسهولة تغيير اي جزء منه. --------------------------------------------------------------- تعديل 15-01-2023 : يمكننا استعمال الاسم القصير Short FileName للتغلب على مشكلة اللغة العربية في استعمال هذا البرنامج 🙂 يصبح الكود: Private Sub cmd_combine_Click() On Error GoTo err_cmd_combine_Click: 'Merge Two or More PDFs into a New Document 'pdftk 1.pdf 2.pdf 3.pdf cat output 123.pdf Dim pdftk_File As String Dim a_FILE As String Dim b_FILE As String Dim ab_FILE As String Dim Command_Line As String pdftk_File = Chr(34) & Application.CurrentProject.Path & "\" & "pdftk" & Chr(34) 'File 'a_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "a.pdf" & Chr(34) a_FILE = Chr(34) & get8_3FullFileName(1, Application.CurrentProject.Path & "\" & "ملف1" & "\" & "a.pdf") & Chr(34) b_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "b.pdf" & Chr(34) 'Folder 'ab_FILE = Chr(34) & Application.CurrentProject.Path & "\" & "ab.pdf" & Chr(34) ab_FILE = get8_3FullFileName(2, Application.CurrentProject.Path & "\" & "المجلد النهائي") & "\" & "ab.pdf" Kill ab_FILE ab_FILE = Chr(34) & ab_FILE & Chr(34) Command_Line = pdftk_File & " " Command_Line = Command_Line & a_FILE & " " Command_Line = Command_Line & b_FILE & " " Command_Line = Command_Line & "cat output" & " " Command_Line = Command_Line & ab_FILE 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide Exit_cmd_combine_Click: Exit Sub err_cmd_combine_Click: If Err.Number = 53 Then 'file not for for deletion Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_cmd_combine_Click End If End Sub . وهذه الدالة التي يتم مناداتها لتغيير المسار الى 8.3 Function get8_3FullFileName(F_or_F As Integer, ByVal sFullFileName As String) As String ' ' Convert the normal path to the old DOS 8.3 path ' this solves the problem of spaces in the path ' and reading Unicode names ' ' F_or_F : File or Folder ' 1= File ' 2= Folder ' Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") If F_or_F = 1 Then get8_3FullFileName = FSO.GetFile(sFullFileName).ShortPath Else get8_3FullFileName = FSO.GetFolder(sFullFileName).ShortPath End If Debug.Print "Original File Path: " & sFullFileName Debug.Print "8.3 File Path: " & get8_3FullFileName End Function . والمرفق Combine_PDF_Files_83.zip فيه المثال اعلاه 🙂 Combine_PDF_Files_2.zip pdftk_2.02.zip Combine_PDF_Files_83.zip

السلام عليكم اخ امجد بارك الله فيك على كلماتك الطيبه جرب المرفق بخصوص كشف الحساب Petty Cash Excel _Ali1.xlsm

السلام عليكم بهذا الكود Private Sub CommandButton1_Click() Dim pth, Nm pth = "D:\my_f\" Nm = Me.ComboBox1.Value & ".*" If Dir(pth & Nm, vbDirectory) = "" Then MsgBox "لايوجد ملف بنفس الاسم بالمسار المحدد لحذفه" Else Kill pth & Nm & ".*" MsgBox "تم حذف الملف بنجاح" End If End Sub

أحسنت استاذ مجدى بارك الله فيك

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

جزاك الله كل خير ورحم الله والديك

ولكن هذ لا يؤثر بالمعادلة, على الرغم من هذا فقد تم التعديل على الملف السابق فقط عليك بكتابة الرقم بس فى الوقت

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

أحسنت استاذ مجدى ..جزاك الله كل خير وأحسن الله اليك

فورم ادخال البيانات والتأكد منها للادخال الفيديو

موديول لاستاذى الجليل ومعلمى القدير الاستاذ @ابوخليل test (5).accdb وهنا التطبيق داخل نموذج مع الاستعلام test (6).accdb

الخلل انك قمت بوضع مسافات ( Space ) قبل وبعد كلمة ( حاضر / غائب ) " غائب " " حاضر " لاحظ المسافات قبل الكلمة وبعدها, احذف المسافات او قم بعمل التنسيق الشرطي مع المسافات وسيعمل بشكل جيد حسنين متابعة غياب طلاب الفراغات.mdb

اخى العيدروس انت مبدع وفقكم الله

نعم رقم الماك لايظهر الا بعد ان يكون جهازك متصل بالانترنت تمت التجربة

عمل ممتاز اسأل الله ان يجعل هذا في ميزان حسناتك

أستاذي @ابا جودى أن طلب العميل البرنامج مفتوح حينها ساقوم بتغيير نوع الحماية في الملف واقوم ارسالة له وأذا أراد أستخدام البرنامج في اكثر من جهاز ساقوم بتفعيل كل واحدا على حدة أستاذي أستغربت من سؤالك هذا جداً برنامج عملت فيه ليل ونهار مايقرب أكثر من سنه ونصف الى سنتين وسهر بشكل متواصل .. هل تريد أن أعطية للعميل بشكل سهل يفعل به مايشاء ؟؟ يمكن أن يعطية لمن يريد ويأخذ مجهود غيرة ؟؟؟

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

اخي الكريم حط مسار المجلد الرئيسي الذي ذكرته بهذا السطر pth1 = ThisWorkbook.Path & "\" فليكن مثلاً "C:\Users\aad\Desktop" يكتب بالمتغير كالتالي pth1 = "C:\Users\aad\Desktop" & "\"

اخي الكريم @qathi ارى انك ترغب بشدة باستعمال الماك ادرس .. اعتقد ان الملف الذي ارفقه لنا الاستاذ اباجودى يؤدي الغرض خصوصاً كود الدالة call NICInfo وهذه صورة من جهازي توضح وجود كروت خاصة ببرنامج VMware

اذا كان بنفس مسار الملف الذي به الكود Private Sub CommandButton1_Click() Dim pth, Nm, Pt, pth1 pth = "D:\my_f\" pth1 = ThisWorkbook.Path & "\" Nm = Me.ComboBox1.Value & ".*" Ar = Array(pth, pth1) For Each Pt In Ar If Dir(Ar & Nm, vbDirectory) = "" Then MsgBox "لايوجد ملف بنفس الاسم بالمسار المحدد لحذفه" & Pt Else Kill Ar & Nm & ".*" MsgBox "تم حذف الملف بنجاح من المسار" & " :" & Pt End If Next Pt End Sub

روح للمجلد الذي بالمسار وانسخ المسار وحطه في المتغير pth = "D:\my_f\" ولاتنسى تحط علامة "\" في نهاية المسار

سويتلك مخطط لكي تفهم قصدي. المخطط ليس صعب او مستحيل تنفيذه، يحتاج مخ صافي وفنجان قهوة 😎 @jjafferr مُعلمي اتمنى منك النقاش حول فكرتي هذه

طيب، دعني اختصر لك الكلام هذا كله. دع تفعيل برنامجك يكون عن طريق النت، اذا كان النت موجود يشتغل برنامجك والا فلن يعمل

بعد إذن أستاذنا الفاضل سليم حاصبيا جرب هذا حساب المكملون بدرس او درسين او اكثر.xlsx

دكتور محمد طلباتك اوامر هنا الملف 18 ميجا تقريبا وهذا موقع فيه ايقونات مميزة https://icons8.com/icons

تفضل ، هذا الرابط به طلبك 🙂 جعفر

السلام عليكم جرب المرفق فورم المبالغ المستلمة و فورم ارشيف العهد كشف الحساب سأعمل عليه لاحقا في امان الله Petty Cash Excel _Ali.xlsm

عظم الله اجركم انا لله وانا اليه راجعون

وعليكم السلام-لك ما طلبت برنامج 1mahmoud.xlsb

أحسنت استاذ سليم معادلات ممتازة بارك الله فيك وزادك الله من فضله

ايه ده كله الطلبات كده كتير جدا

اهلا بك فى المنتدى تفضل -تم ذلك بمعادلات المصفوفة كود.xlsm

راجع هذا الموضوع اضغط هــنــا

تفضل تم التعديل على الملف لكى تعمل المعادلات مباشرة بدون التدخل فيها فقط عليك بتغيير النسبة أعلاه فقط كما تريد (تكتب فقط رقم النسبة بدون اى اضافات بالخلية) وسترى عمل المعادلات وتغيرها مباشرة Stable Pressure Tolerances 3.xlsx

برنامج المخزون و الفواتير الشامل .... الاصدار الثالث اكسيل 2007 - اكسيل 2010 اليوم بمشيئة الله هو الانطلاق الرسمى لهذة النسخه وبعد انتهاء مرحلة التجربة التى دامت اكثر من شهرين خطوات استخدام البرنامج لأول مره تسجيل البيانات الجديدة داخل البرنامج لعمل فواتير البيع و الشراء و الحركات المالية 1- تسجيل اسماء مناديب البيع وهى خطوه مهمه مطلوبة لتسجيل اسم عميل جديد 2- تسجيل و ادخال العملاء (يتم ربط كل عميل باسم مندوب) 3- تسجيل و ادخال الموردين 4- تسجيل و ادخال اسماء لفئة الصنف وهى خطوه مهمه مطلوبة لتسجيل صنف جديد 5- تسجيل و ادخال الاصناف (ولابد من وجود فئة مدخله مسبقا لكى تستطيع ادخال الصنف) 6- ولا تنسى تسجيل رصيد اول المده فى شاشة البيانات و الجرد الجديد فى هذا الاصدار * واجهة تطبيقية كاملة * برنامج كامل مخزون فواتير ذمم عملاء وموردين واستحقاقات خلال الفترات الزمنية المختلفة * اختصارات سريعة لتنفيذ العمليات و التقارير بسرعة عالية * كشف حساب بطريقة جديدة بمعنى نفترض انه هناك عميل ما علية مديونية بفيمة 15000 فالبرنامج يعطيك كشف حساب تفصيلى للمديونية المستحقة خلال فترات 30 يوم 60 يوم 90 يوم و اكثر من 90 يوم فمثلا فى المثال السابق يكون استحقاق المديونية على حسب فواتير العميل مستحق فى 30 يوم 3000 وفى 60 يوم 6000 وفى 90 يوم 4000 و فى اكثر من 90 يوم 2000 فيكون اجمالى المديونية هم ال 15000 لكن الاستحقاق فى فترات مختلفه وهذا الكشف يفيد كل من يتعامل بالاجل لمعرفة المستحق خلال الفترة التى يريدها وعندما يقوم العميل بسداد جزء من المستحق يتم خصمه من المديونية القديمه بمعنى ان العميل فى المثال السابق قد قام بسداد 1500 فيتم خصمها من ال 2000 وهى مديونية الاكثر من 90 فيصبح كشف حسابة كالتالى مستحق فى 30 يوم 3000 وفى 60 يوم 6000 وفى 90 يوم 4000 وفى اكثر من 90 يوم 1500 فيكون اجمالى المديونية هم ال 13500 * شاشة فواتير جديده تحوى الكثير و الكثير من الاختصارات للعملاء و الاصناف وتوصلك الى عدة تقارير بضغطة زر واحده عرض معلومات عن الصنف و رصيده الحالى داخل المستودع و اخر سعر شراء بمجرد اختيارك للصنف وادخاله داخلة الفاتوره سهولة الغاء وتعديل الصنف داخل الفاتورة عن طريق الدبل كليك ذهاب مباشره الى تقرير صنف معين بمجرد اختياره وضغط تقرير الصنف اكتشف المزيد............ *شاشة لتقرير المديونية خلال الفترات الزمنية المختلفة يجب عليك قراءة ومراجعة شرح البرنامج جيدا حيث توجد العديد و العديد من الاختصارات السريعة التي تنقلك من شاشة الى اخرى بسرعه عالية ولتوفير وقتك داخل البرنامج. كما توفر لك سرعة الحصول على المعلومة المطلوبة. * لتحميل نسخة من الشرح وهى عبارة عن ملف تنفيذي اضغط على الرابط التالى شرح برنامج المخزون و الفواتير الشامل( ملف تنفيذى... 6MB رابط خارجى على موقع ميديا فاير) * او الذهاب الى موضوع شرح البرنامج و مناقشات مشرفى و اعضاء المنتدى داخل المنتدى على الرابط التالى شرح برنامج المخزون و الفواتير الشامل(مشاركة داخل المنتدى) كما احببت ان اقدم مناقشة ونصائح مديري و اعضاء المنتدى للبرنامج لكى يستفيد منها الجميع وهذه المواضيع تم مناقشتها في موضوع شرح البرنامج داخل المنتدى انظر المشاركة التالية لمشاهدة النصائح و المناقشات حول البرنامج واخيرا اقدم لكم البرنامج حجم البرنامج 1.2 MB اختر اسم المستخدم المدير كلمة السر 123 محرر الاكواد 85211 لاتترد فى الاستفسار عن اى شيى داخل البرنامج ضع مشاركتك وسوف يتم الرد عليها كما يمكن مراسلتى على الايميل التالى amroomo@gmail.com اخيرا اتمنى ان يكون هذا البرنامج اضافة الى برامج المخزون و الفواتير وتغيير مسارها على الاكسيل فهذا العمل جديد بكل المقاييس فى افكاره التى اتمنى ان اكون قدمتها بصورة جيدة ويستقيد بها الجميع وَقُلْ رَبِّ زِدْنِي عِلْمًا ========================================================= المرفق المحدث الاخير: SIS 3.152 (Add City).rar

السلام عليكم اخى الكريم لابد من حفظ الملف بصيغة XLSM. بارك الله فيك

تفضل بعد اذن استاذى الكبير ابراهيم له منا كل المحبة والإحترام Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 3 Or Target.Row < 7 Then Exit Sub Dim C As Range For Each C In Range("C7:C" & Range("C" & Rows.Count).End(xlUp).Row) If C.Value = "سدد" Or C.Value = "انهى" Or C.Value = "خالص" Then C.Offset(0, 1).Resize(1, 12).Value = "0" C.Offset(0, 13).Resize(1, 3).Value = "لا" End If Next End Sub

تفضل لك ما طلبت 2قائمة منسدلة مطاطية.xlsm

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

وعليكم السلام يمكنك عمل هذا حتى بدون اكواد عليك بمشاهدة هذا الفيديو https://www.youtube.com/watch?time_continue=1&v=1xHS1snXRKs

جرب هذا الملف بمجرد كتابة الحرف الأول والثانى مثلا ثم اضغط على انتر يتم كتابة الإسم كاملا Search.xlsm

وضح بالتفصيل لو سمحت على الملف لما تريده

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

تفضل استاذى الكريم الملف غير محمى مراقبة الاقساط.xlsx

السلام عليكم اولا عليك بإنشاء صفحة جديدة فى ملفك تحت اسم Welcome ثم بعد ذلك عليك بفتح موديول جديد ووضع فيه هذان الكودين : Sub CommitSuicide() With ThisWorkbook Application.DisplayAlerts = False If .Path <> vbNullString Then .ChangeFileAccess xlReadOnly Kill .FullName End If .Close SaveChanges:=False End With End Sub Sub Locked(ByVal bEnabled As Boolean) Dim sh As Worksheet Dim iHome As Integer Dim iOthers As Integer If bEnabled = True Then iHome = -1 'visible iOthers = 2 'very hidden Else iHome = 2 iOthers = -1 End If With ThisWorkbook On Error Resume Next Application.ScreenUpdating = False .Sheets("Welcome").Visible = iHome For Each sh In .Sheets If Not sh.Name = "Welcome" Then sh.Visible = iOthers End If Next sh .Sheets("Welcome").Visible = iHome Application.ScreenUpdating = True On Error GoTo 0 End With End Sub ثم بعد ذلك ضع هذان الكودين فى حدث ThisWorkBook وعليك بوضع اسم كمبيوترك داخل الأقواس اللى فى هذا السطر من الكود Select Case Environ("COMPUTERNAME") Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Locked True End Sub Private Sub Workbook_Open() Select Case Environ("COMPUTERNAME") Case "LPPC28" 'approved computers Locked False Case Else CommitSuicide End Select End Sub وأخيراً وضع الكود التالى فى حدث الصفحة الجديدة Welcome Private Sub Worksheet_SelectionChange(ByVal Target As Range) Locked False End Sub بارك الله فيك

تفضل التعديل الخامس (2) (2) (1).xlsm

اهلا بك اخى الكريم فى المنتدى تفضل الملف بدون حماية FindAll.xlsm

وعليكم السلام اهلا بك اخى الكريم أحمد فى المنتدى-كان عليك استخدام خاصية البحث فى المنتدى فهناك موضوعات مشابهة لموضوعك ومنها : https://www.officena.net/ib/topic/51238-ادخال-بيانات-في-ورقة-اكسل-من-اكثر-من-شخص-في-نفس-الوقت/ https://www.officena.net/ib/topic/46928-هل-ممكن-رفع-ملف-اكسيل-على-الانترنت-والتعامل-معه/?page=2 كما ان هناك عدة فيديوهات لهذا ومنها : https://www.youtube.com/watch?v=73_YJEg3FtU https://www.youtube.com/watch?v=0ZnnPiW25GQ https://www.youtube.com/watch?v=rVse23rIS4A وهناك ايضا مواقع خارجية تناولت هذه الجزئية من الموضوعات ومنها : http://excel-egy.com/forum/t49 https://www.techonthenet.com/excel/questions/shared.php https://www.ablebits.com/office-addins-blog/2017/08/02/excel-shared-workbook-share-file-multiple-users/ اتمنى ان تكون مفيدة لك بارك الله فيك