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

ضع 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

جرب ShellWait (ولكن استعمل النسخة اللي استعملناها في برنامج QR https://www.officena.net/ib/topic/90906-كارنيهات-باستخدام-باركود-ماتركس-qr-code/ )

لا استطيع الاستمتاع بالتجربة يوجد مشكلة باتصال الانترنت واتابع من الجوال

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

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

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

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

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

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

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

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

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

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

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

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

تم تجريب الملف الآن و يعمل 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

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

السلام عليكم 🙂 - كود البرنامج تم تغييره بالكامل ، - رجاء حذف الصور والمجلدات اللي عندك ، واستدعي الصور وملفات pdf من جديد ، - يجب ادخال "تبويب القسم" ، والذي يتم حفظه في الجدول ، - البرنامج يصنع مجلد السنة ، وبداخله مجلدات "تبويب القسم" (لأن السنوات القادمة سيكون لها نفس تسلسل هذه السنة ، وكذلك لترتيب المجلدات والملفات) ، - داخل مجلدات "تبويب القسم" ، يتم حفظ الصور او ملفات pdf ، بإسم التسلسل ، - الخطأ في برنامجك السابق ، انك كنت تعمل نسخة من الصور/pdf ، فتكون عندك نسختان من كل ملف ، بينما الآن فيتم حذفه من المكان الاصل انشاء الملف في المجلد الصحيح ، جعفر 1192.ProgSccaner20.mdb.zip

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

تفضل لك ما طلبت 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 تحياتي

غالبًا يحدث ذلك إذا كان هناك تعارض في أنماط المستند (أي وجود نمط مكرر ) إذا وجدت نمط مكرر في خريطة أنماط المستند قم بحذفه. وأيضًا قد تجد في خريطة أنماط المستند . نمط له اسم char قم بحذفه أيضًا أو اي نمط بهذا المسمى. ثم قم بحفظ الملف باسم واختر docm وليس docx سوف يجعله أسرع وأكثر استيعابًا للصفحات مهما زادت عددها وخاصةً إذا كان بداخل المستند صور كثيرة أو معادلات . قم بالتجربة وأخبرنا بالنتيجة. وفقنا الله وإياك.

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

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

TRY THIS FILE ROW_NYMMBER.xlsx

حياك استاذي الغالي الوزير بالنسبة لحركة المخزون وإضافة الكميات تنقسم إلى عمليتين : 1- العمليات الواردة ( + ) عن طريق ( فاتورة شراء ، وفاتورة مرتجع البيع ). 2- العمليات الصادرة ( - ) عن طريق ( فاتورة مبيعات - مرتجع الشراء ) . لذا لدينا جدولان هما محورا البرنامج 1- رأس الفاتورة (tblFatora) . 2- وأطرافها (tblHaraka). الأطراف يحوي جميع حركات الأصناف داخل وخارج المخزون . إما إضافة الكميات الواردة عن طريق رصيد الأصناف في جدول الأصناف لا احبذها لان الصنف يمر بصعود ونزول في السعر .عليه أرى إضافة الكميات داخل المخزون عن طريق فاتورة شراء ليكون سعر كل صنف معه . هذا كان اجتهاد مني وما تعلمته خلال تجربتي البسيطة في بعض البرامج المحاسبية .ويبقى هذا العمل بشري يعتريه من النقص والسهو ولكن أكررها أنا لست محاسبة وزميلي محاسب كنت أخذ رأيه ورأي زملائي في بعض الأمور المحاسبية . وما نحن إلا حسنة من حسنات علمكم . والباب مفتوح للمناقشة للجميع؟

اهلاً معلمي الغالي, تلبية لطلبك الكريم قمت بجمع الطريقتين بملف واحد اذا وضعت مسار ملف صوت 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

لا أعتقد أن هذا نوع من الحماية وعلى أي حال لماذا لا نقوم بعمل ماكرو يقوم بإرجاع الملف إلى حالته بعد نسخه من ملف الأكروبات عن طريق تغيير ترتيب الأحرف .. أعتقد أن هذا الأمر ممكن .. وهذا مثال يمكنكم التعديل عليه: Sub Macro() 'الذهاب إلى أول المستند Selection.HomeKey Unit:=wdStory 'معرفة عدد الكلمات في المستند Set wdDTWC = Dialogs(wdDialogToolsWordCount) wdDTWC.Execute dlgwordcount$ = wdDTWC.Words 'تحديد كلمة كلمة For o = 1 To dlgwordcount$ Selection.Find.ClearFormatting With Selection.Find .Text = "<?*>" .MatchWildcards = True End With Selection.Find.Execute 'وضع الكلمات في متغيرات Dim x As String Dim s As String x = Len(Selection) s = Selection 'قلب الكلمة إلى وضعها الطبيعي For i = 0 To x - 1 Selection.TypeText Text:=Mid(s, (x - i), 1) Next Next End Sub