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

ضع MYFOLDER في C الملف يعمل بكفاءة عالية افتح الملف MASTER و قم بجلب الملفات. الكود يعمل بكفاءة عالية. ربما المشكل عندك في الجهاز MyFolder.rar

اذا بكره الله سبحانه وتعالى اعطانا عمر ، فأشوف الموضوع ان شاء الله 🙂 جعفر

وعليكم السلام باشمهندس 🙂 لك وحشه يا راجل 🙂 الامر ShellWait يعمل تماما مثل Shell ، فقط تغير اسم الامر ، وخلاص 🙂 جعفر

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

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

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

تفضل نسخ غياب1.xlsm

رحم الله والديك دنيا وآخرة ، و زاد الله فضله عليك 🙂 في هذه الحالة ، بالاضافة الى مشاركتي السابقة مع المرفق ، عندك طريقة اخرى ، وبدون الوحدة النمطية الثانية : Public Function Make_File() Dim BE_Path, PauseTime, Start 'get the server path BE_Path = DLookup("[Database]", "MSysObjects", "[Database] Is Not Null") 'Path and BE name BE_Path = Mid(BE_Path, 1, InStrRev(BE_Path, "\")) BE_Path = BE_Path & "dummy.txt" 'make the dummy txt file Open BE_Path For Output As #1 Print #1, "No text required" Close #1 'pasue for a second, until file is recognized, for slow networks PauseTime = 1 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop 'get the date created Make_File = FileDateTime(BE_Path) 'clean up, delete the file Kill BE_Path End Function جعفر

أخي عبد الله السعيد . يمكن أنك تستعمل ملفات أخرى غير المرسلة من طرفك 1- يجب أن تكون الملفات هنا : C:\MyFolder و اذا كانت ملفاتك في مجلد آخر غيره في الكود : في هذا السطر fPath = "C:\MyFolder\" 2- تأكد من امتداد الملفات 3-اسم الورقة التي تجلب منها البيانات في الملفات المتعددة ربما ليست SHEET1 غيرها في الكود اذا كنت تستخدم اسم آخر في هذا السطر LR = Worksheets("SHEET1").Range("XEY" & Rows.Count).End(xlUp).Row Worksheets("SHEET1").Range("XEY2:XFD" & LR).Copy 4- ربما ورقة العمل في الملف الرئيسي ليست "MASTER"في ملفك الرئيسي . غيرها في هذا السطر Set wsMaster = ThisWorkbook.Sheets("Master") بالتوفيق

شكرا جزيلا 🙂 اذن ، مافي داعي للتعديل اليدوي على كل برنامج ، فرجاء تعديل الوحدة النمطية الى : Public Function Make_File() Dim BE_Path, PauseTime, Start 'get the server path 'BE_Path = DLookup("[Database]", "MSysObjects", "[Flags]=2097152") 'Path and BE name BE_Path = Get_DB_Path_2 'Path and BE name BE_Path = Mid(BE_Path, 1, InStrRev(BE_Path, "\")) BE_Path = BE_Path & "dummy.txt" 'make the dummy txt file Open BE_Path For Output As #1 Print #1, "No text required" Close #1 'pasue for a second, until file is recognized, for slow networks PauseTime = 1 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop 'get the date created Make_File = FileDateTime(BE_Path) 'clean up, delete the file Kill BE_Path End Function Public Function Get_DB_Path_2() Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("SELECT Database FROM MSysObjects WHERE (MSysObjects.Database) Is Not Null") Get_DB_Path_2 = rst(0) rst.Close: Set rst = Nothing End Function جعفر my_FE.mdb.zip

بعد اذن الاستاذ واتراء للموضوع يمكنك استخدام الكود التالي في حدث ورقة العمل Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim rng Dim lr lr = Cells(Rows.Count, 1).End(3).Row Set rng = Range("a3:a" & lr) If Not Intersect(Target, rng) Is Nothing Then Range("j3:j" & lr).Formula = "=B3&"" ""&C3&"" ""&D3&"" ""&E3" Value = Value End If End Sub

تفضل الملف ماستر . بعد الانتهاء من نقل أي ملف يرسله الى مجلد ملفات مستوردة للامانة الكود منقول مع تعديلات بسيطة MASTER.xlsm

بعد اذن الاساتذة الافاضل واتراء للموضوع جرب المرفق قم بفك الضغط وضع المجلد في اي فولدر تريد MyFolder.rar

السلام عليكم هل يمكن تشغيل الاصوات تباعا من المكتبة الصوتية الموجوده بالمرفق هنا يعنى بعد الانتهاء من - aoj3ene يتم تشغيل - nor ثم بعد الانتهاء منه يتم تشغيل - فضلكم ياوالدي بطريقة اليه وان امكن هل ممكن وضه مثلا Checkbox ان كان True يتم التشغيل تباعا وان كان False يتم التوقف بعد الانتهاء من تشغيل الملف الحالى ؟! المرفق APP_Player.zip

تفضل نسخة accdb وتم إضافة بعض التحسينات في هذه النسخة . BuySal20_V14.accdb BuySal20_V14.accdb.mdb.zip

وجزيت خيرا اخي الحمد لله ان تم المطلوب

اعتذر اخي وقع خطأ تفظل hr2.xlsm

هذا ما اردته بالضبط الله يرفع قدرك ويبارك لك في صحتك ويزيدك من علمه وفضله

رما يكون في التعديل ما تقصد _سجل حضور وانصراف.xlsm

منا جزيل الشكر والعرفان جزيت خيرا

وعليكم السلام-لك ما طلبت تحويل الارقام الى عربي عند استدعاء البيانات1.xls

همممم احنا نتكلم عن موضوعين مختلفين !! انا قلت اجعل المستخدم يضغط على الزر اللي على جهاز السكانر : . بينما انت تريد : . وانا رديت عليك مسبقا وقلت : جعفر

انت تامر ابشر تفضل

الظاهر انك ما فهمت مشاركتي الاخيرة !! كلامي كان ، بعد ان تعمل اعدادات الاسكانر يدويا : - حفظ الملفات في مجلد خاص بالسكانر (لا مو مجلد Downloads طبعا) ، - اذا كانت صيغة الحفظ jpg فيجب ان تكون النقاوة 100% وبدون ضغط ، - دقة الصورة على الاقل 300dpi ، اما اذا اردت تحويل الصورة الى نص عن طريق برامج OCR فيوصى برفع الدقة الى 600dpi ، - او حفظ الملف بصيغة pdf ، مع مراعاة نقطتي النقاوة والدقة اعلاه . وكل مرة ، وبعد ان يتم المسح الضوئي يدويا : وبرامج التحويل هذه ، بعمل لها موضوع مستقل في المنتدى ، بحيث تقدر تستفيد منه مباشرة ، وبدون أجر 🙂 جعفر

وكذلك تجربة اخيرة لوسمحت ، جرب هذا الكود في نافذة immediate : ?DLookup("[Database]", "MSysObjects", "[Database] Is Not Null") جعفر

تفضل . أرجو أن يكون طلبك ,,, Database6.accdb

في شيء ممكن نعمله وهو ، بعض الاسكانرات ممكن نعمل لها اعداد واحد فقط لأخذ الصور بصيغة jpg او pdf ، وهنا ممكن ان نستعمل برامج خارجي (يتم التحكم به عن طريق البرنامج) ، ويقوم بتحويل هذه الملفات الى الصيغة الأخرى ، يعني من jpg الى pdf ، او من pdf الى jpg ، سواء لورقة واحدة او عدة اوراق 🙂 جعفر

تم تجريب الملف الآن و يعمل 100/100 . قم بحذف جميع الملفات من مجلد الملفات المستوردة و احذف الملف 00 . من مجلد MYFOLDER . و استعمل الملف المرسل بدلا منه.

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

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

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

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

وعليكم السلام-جرب هذا How to Copy or Import VBA Code to Another Workbook أو هذا Copy every worksheet from one excel file to another او يمكنك بطريقة بسيطة بأن تقوم بتحديد كل صفحات الملف بطريقة يدوية ثم بعد ذلك تقوم بالضغط كليك يمين بالماوس ثم اختيار move or Copy ثم بعد ذلك اختيار ملف الإكسيل الذى تريد نقل الصفحات اليه وتحديد كل الصفحات التى تريد نقلها ... فسيتم النقل ايضا بالمعادلات وبنفس تنسيقات الملف القديم اما بالنسبة لنقل الأكواد فقط عليك بفتح الملف القديم والملف الجديد والدخول الى محرر الأكواد بالضغط على Alt F11 ثم الضغط الى الكود الذى تريد نقله وسحبه الى المكان الجديد بالملف الجديد

جرب هذا الملف Split_name.xlsm

السلام عليكم اخوي سلمان 🙂 الحمدلله 🙂 بس الآن خلينا نجرب نعمل الكود تلقائي ، لوسمحت تجرب هذا الكود في البيئة اللي عندك ، علشان يكون مرجع لبقية الاعضاء 🙂 ضع هذا الكود في وحدة نمطية : Public Function Get_DB_Path_2() Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("SELECT Database FROM MSysObjects WHERE (MSysObjects.Database) Is Not Null") Get_DB_Path_2 = rst(0) rst.Close: Set rst = Nothing End Function . وبعدين في النافذة اللي تحت (immediate) اكتب التالي (تأكد ان الكيبورد انجليزي ، وعلامة الاستفهام بالانجليزي) ، وارفق لنا صورة بالنتيجة : ?Get_DB_Path_2 . هذه نتيجة العمل على كمبيوتري : . جعفر

تفضل أخي أكتب فقط تاريخ البدء و الساعة في الخلية C7 . و اكسل يقوم بالباقي. يمكنك سحب المعادلات الى الاسفل لمزيد من اسماء المداومين. جدول المداومة.xlsx

لم أفهم المطلوب. لكن هذه محاولة لاستخراج تاريخ آخر قسط من العمود J الى العمود AM ثم حساب المدة منذ آخر قسط. عدد الشهور المستحقة حتى الان.xls

السلام عليكم تفضل اتمنى هذه المرة ان يكون المطلوب تحياتي البرنامج-1.rar

تفضل لك ما طلبت Payroll.xlsm

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub N1_BeforeUpdate(Cancel As Integer) On Error Resume Next If Me.NewRecord = True Then Dim strWhere As String, strMessage As String strWhere = "[B] = '" & Me![N1] & "'" Me.RecordsetClone.MoveFirst Me.RecordsetClone.FindFirst strWhere If Me.RecordsetClone.NoMatch = False Then strMessage = " الصنف مكرر" lResponse = MsgBox(strMessage, vbOKOnly + vbCritical) If lResponse = vbOK Then Cancel = True Me.Undo Me.Bookmark = Me.RecordsetClone.Bookmark End If End If End If End Sub TEST11.rar تحياتي

هذه العلامة طالما انك تريد من المعادلة العد فلابد من وضعها واذا جربت ازالتها فلم يخرج الناتج كما تريد

وعليكم السلام -يمكنك استخدام هذه المعادلة =SUMPRODUCT(--($H$10:$H$20=$N1),SUBTOTAL(2,OFFSET($G$10:$G$20,ROW($H$10:$H$20)-ROW(H10),0,1))) فلترة1.xlsx

السلام عليكم ورحمة الله تفضل اخى الكريم الصالة.rar

و هذا رابط موضوع مثيل فى الوورد

TRY THIS FILE ROW_NYMMBER.xlsx

اهلاً معلمي الغالي, تلبية لطلبك الكريم قمت بجمع الطريقتين بملف واحد اذا وضعت مسار ملف صوت MP3 او WAV فهو سيقوم بفلترة المدخلات وتشغيلها حسب صيغتها. Option Compare Database Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _ "mciSendStringA" (ByVal lpstrCommand As String, ByVal _ lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _ hwndCallback As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _ (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long Private Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long Const SND_ALIAS_SYSTEMASTERISK As String = "SystemAsterisk" Const SND_ALIAS_SYSTEMDEFAULT As String = "SystemDefault" Const SND_ALIAS_SYSTEMEXCLAMATION As String = "SystemExclamation" Const SND_ALIAS_SYSTEMEXIT As String = "SystemExit" Const SND_ALIAS_SYSTEMHAND As String = "SystemHand" Const SND_ALIAS_SYSTEMQUESTION As String = "SystemQuestion" Const SND_ALIAS_SYSTEMSTART As String = "SystemStart" Const SND_ALIAS_SYSTEMWELCOME As String = "SystemWelcome" Const SND_ALIAS_YouGotMail As String = "MailBeep" ' playsound Params Const SND_LOOP = &H8 Const SND_ALIAS = &H10000 Const SND_NODEFAULT = &H2 ' silence if no sound associated with event Const SND_ASYNC = &H1 ' play async (don't freeze program while sound is playing) Private sMusicFile As String Dim Play, a Public Sub Sound_MP3(ByVal File$) sMusicFile = GetShortPath(File) Play = mciSendString("play " & sMusicFile, 0&, 0, 0) If Play <> 0 Then End If End Sub Public Sub Stop_MP3(Optional ByVal FullFile$) Play = mciSendString("close " & sMusicFile, 0&, 0, 0) End Sub Public Function GetShortPath(ByVal strFileName As String) As String Dim lngRes As Long, strPath As String strPath = String$(165, 0) lngRes = GetShortPathName(strFileName, strPath, 164) GetShortPath = Left$(strPath, lngRes) End Function Private Sub DoStartSound_Click() If IsNull(SoundPath) Then MsgBox "! áã ÊÞã ÈæÖÚ ãÓÇÑ ãáÝ ÇáÕæÊ", vbCritical, "ÚãáíÉ ÎÇØÆÉ" Exit Sub End If Dim Fix_Path As String Fix_Path = Mid(SoundPath, 2) Dim Rev_Extension As String Rev_Extension = FExtOnly(Fix_Path) If IsFile(Fix_Path) = False Then MsgBox "! áã íÊã ÇáÚËæÑ Úáì ÇáãáÝ", vbCritical, "ÚãáíÉ ÎÇØÆÉ" Exit Sub End If Select Case Rev_Extension Case "mp3" Sound_MP3 (Fix_Path) Case "wav" PlaySound Fix_Path, vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC Or SND_LOOP End Select Debug.Print Fix_Path End Sub Function IsFile(ByVal fName As String) As Boolean On Error Resume Next IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory) End Function Function FExtOnly( _ ByVal filename As String) _ As String Dim nopath As String Dim dpos As Long Dim spos As Long spos = InStrRev(filename, "\") If spos > 0 Then nopath = Mid(filename, spos + 1) Else nopath = filename End If dpos = InStrRev(nopath, ".") If dpos > 0 Then FExtOnly = Mid(nopath, dpos + 1) Else FExtOnly = "" End If End Function Private Sub DoStopSound_Click() Dim Fix_Path As String Fix_Path = Mid(SoundPath, 2) Dim Rev_Extension As String Rev_Extension = FExtOnly(Fix_Path) Select Case Rev_Extension Case "mp3" Stop_MP3 (Fix_Path) Case "wav" PlaySound vbNullString, ByVal 0&, SND_NODEFAULT End Select End Sub حسنين MP3_WAV_Player_SEMO_Pa3x.accdb

لا داعي للتحويل يمكنك تشغيل ملف صوت mp3 بإستخدام الدالة mciSendStringA تصريح الدالة: Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _ "mciSendStringA" (ByVal lpstrCommand As String, ByVal _ lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _ hwndCallback As Long) As Long تفضل سويتلك مشروع بسيط ان شاء الله ينفعك Mp3Sounds_SEMO_Pa3x.accdb

في الشرح في مرحلة التنصيب في الصور الصورة الثانية لم تضهر لي

السلام عليكم Transaction_his.rar

الإخوة الكرام السلام عليكم ورحمة الله وبركاته كثيراً ما كانت تخطر ببالي فكرة البحث عن كلمة في مئات الملفات بطريقة سهلة وميسرة وسألني أحد الإخوة قبل يومين عن هذه الفكرة وأن أقوم بعملها .. فقلت سأحاول .. وقد حاولت وأعان الله ووفق وسدد فله الحمد أولاً وآخراً وظاهراً وباطنا أرجو أن يعجب الإخوة الكرام --------- افتح الملف المرفق وفي شريط الأدوات (بحث_أحمد الحربي) انقر زر (البحث في ملفات وورد المغلقة .. أحمد الحربي) FindInWordFile.rar