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

تفضل اخي الكريم 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

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

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

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

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

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

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

اذا كان بنفس مسار الملف الذي به الكود 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 مُعلمي اتمنى منك النقاش حول فكرتي هذه

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

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

نفس تعليقي اعلاه 🙂 جعفر

هات الملف (نموذج ما لا يزيد عن 5 صفوف) و خذ ما يدهش العالم

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

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

قم بعمل رقم سري للملف لم يستطيع احد استغلال ملفك الا اذا كان يملك الرقم السري حتى لو قام بعمل حفظ باسم للملف سوف يطلب الرقم السري الخطوات : File- Info - Protect Workbook - Encrypt With Password

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

See this file faltara.xls

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

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

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

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

تفضل هذه الصورة للتوضيح

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

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

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

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

وعليكم السلام احسنت بارك الله فيك

لأ اخى الكريم ليس هذا المطلوب يجب عليك وضع بين الأقواس اسم جهازك انت فعلى سبيل المثال جهازى كالأتى مع اسم جهازى Select Case Environ("AliMohamed")

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

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

وعليكم السلام تم عمل اللازم عليك اختيار الإسم فقط من القائمة المنسدلة والباقى سيأتى تلقائيا بالمعادلات Search.xlsx

تفضل استاذى الكريم الملف غير محمى مراقبة الاقساط.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/ اتمنى ان تكون مفيدة لك بارك الله فيك