husain alhammadi

السلام عليكم ورحمة الله وبركاته، أحبائي وإخواني في منتدانا، كم هو جميل أن نلتقي على الخير ونتعاون عليه! وكم هو أعظم أن نقدم صدقة جارية تبقى بعد رحيلنا. من هذا المنطلق، أود أن أعلن لكم عن إطلاق برنامج لتعليم الصلاة. هذا البرنامج هو مجرد محاولة بسيطة مني لتقديم علم نافع، ليكون صدقة جارية عني وعنكم. إنه مصمم ليكون سهلًا ومباشرًا، ليساعد كل من يسعى لتقوية علاقته مع الله من خلال الصلاة. ما يميز هذا البرنامج؟ تعليم عملي: يغطي خطوات الصلاة من التكبير إلى التسليم، مع إرشادات مبسطة. محتوى موثوق: يعتمد على مصادر شرعية موثوقة لضمان صحة المعلومات. مشاركة الأجر: كل من ينشر هذا البرنامج ويدل عليه، سيكون له أجر من استفاد منه، فالخير لا يكتمل إلا بتعاوننا. أرجو أن يكون هذا العمل في ميزان حسناتنا جميعًا، وأن يجعله الله خالصًا لوجهه الكريم. جزاكم الله خيرًا. أخوكم تعليم الصلاة للاطفال.xlsm

Sub ListFilesInFolderWithHyperlink_Optimized_WithOptions() ' Declares variables for file system objects and Excel ranges. Dim FSO As Object Dim Folder As Object Dim File As Object Dim Rng As Range Dim FolderPath As String Dim LastRow As Long Dim UserChoice As Long ' Define the list of folder paths. Dim FolderPaths(1 To 3) As String FolderPaths(1) = "C:\Users\husain\OneDrive\سطح المكتب\ارشيف\كشف.xlsm" FolderPaths(2) = "C:\Users\husain\OneDrive\سطح المكتب\ارشيف\ملفات" FolderPaths(3) = "C:\Users\husain\OneDrive\سطح المكتب\ارشيف" ' Prompt the user to choose a folder. UserChoice = Application.InputBox(Prompt:="الرجاء اختيار المجلد المطلوب:" & vbCrLf & _ "1: ملف كشف.xlsm" & vbCrLf & _ "2: مجلد ملفات" & vbCrLf & _ "3: مجلد ارشيف", _ Title:="اختيار المجلد", Type:=1) ' Check if the user made a valid choice. If UserChoice >= 1 And UserChoice <= 3 Then ' Set the selected folder path. FolderPath = FolderPaths(UserChoice) Else MsgBox "تم إلغاء العملية أو اختيار غير صالح.", vbExclamation, "إلغاء" Exit Sub End If ' Set the worksheet to be used. With ThisWorkbook.ActiveSheet ' Clears any previous data and hyperlinks from the specified range. LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row If LastRow > 1 Then .Range("B2:B" & LastRow).ClearContents End If .Hyperlinks.Delete ' Create the FileSystemObject. Set FSO = CreateObject("Scripting.FileSystemObject") ' Check if the folder exists. If FSO.FolderExists(FolderPath) Then ' Get the folder object and set the starting cell. Set Folder = FSO.GetFolder(FolderPath) Set Rng = .Range("B2") ' Loop through each file in the folder and add a hyperlink. For Each File In Folder.Files .Hyperlinks.Add Anchor:=Rng, Address:=File.Path, TextToDisplay:=File.Name Set Rng = Rng.Offset(1, 0) Next File ' Loop through each subfolder and add a hyperlink. For Each Folder In Folder.SubFolders .Hyperlinks.Add Anchor:=Rng, Address:=Folder.Path, TextToDisplay:=Folder.Name Set Rng = Rng.Offset(1, 0) Next Folder ' Displays a success message. MsgBox "تمت إضافة أسماء جميع الملفات والمجلدات كروابط تشعبية بنجاح.", vbInformation, "عملية ناجحة" Else ' Displays an error message if the folder path is invalid. MsgBox "مسار المجلد غير موجود. يرجى التحقق من المسار.", vbCritical, "خطأ" End If End With ' Release objects from memory. Set FSO = Nothing Set Folder = Nothing End Sub السلام عليكم ورحمه الله و بركاتة ارجو من اخواتي خبراء تاكد من الكود المرفق و تعديلها و المطلوب 1- عند اضافة في ملف (ملفات) يتم نقلها مباشرة الي ملف كشف مع ارتباط تشعبي 2- في حالة اضافة او تعديل في ملف (ملفات) يتم نقل التعديل مباشرة الي ملف كشف و جزاكم الله خيرا كشف.xlsm

للرفع

اخواني ارجوا مساعدتي فى حصول على تلاوة الشيخ مشاري بن راشد العفاسي الصوت فقط خاص بالصلاة في ثلاثة مقاطع 1- الله اكبر 2- التسليم (سمع الله لمن حمده و السلام عليكم و رحمة الله و بركاتة السلام عليكم و رحمة الله و بركاتة) 3-سمع الله لمن حمده 4- سورة الفاتحة (بدون اعوذ بالله من الشيطان الرجيم ) و جزاكم الله خير الجزاء

السلام عليكم و رحمة الله و بركاتة اسال الله رب العرش العظيم ان يزيد في علمك فعلا هذا المطلوب انت مبدع بمعنى كلمة جزاك الله خير الجزاء استاذى هل يمكن اضافة الصوت للعلم سيتم اضافة الصوت للجميع ما عدا Login_screen بدون صوت اسم نمودج المستخدم الوقت بالثواني ملف الصوت Login_screen 10 UserForm1 45 C:\Users\husain\OneDrive\سطح المكتب\تجربة\اقامة الصلاة.mp3 UserForm2 10 UserForm3 51 C:\Users\husain\OneDrive\سطح المكتب\تجربة\سورة الفاتحة.mp3 UserForm4 21 C:\Users\husain\OneDrive\سطح المكتب\تجربة\سورة الاخلاص.mp3 UserForm6 10 UserForm7 10 UserForm8 10 UserForm9 10 UserForm10 10 UserForm11 10 UserForm3 51 C:\Users\husain\OneDrive\سطح المكتب\تجربة\سورة الفاتحة.mp3 UserForm5 33 C:\Users\husain\OneDrive\سطح المكتب\تجربة\سورة الفلق.mp3 UserForm6 10 UserForm7 10 UserForm8 10 UserForm9 10 UserForm10 10 UserForm12 10 UserForm13 10

السلام عليكم و رحمة الله و بركاتة اخواني الخبراء هل يمكن دمج كودين فى UserForm1 اضافة الصوت WindowsMediaPlayer1 هذا كود يوزرفورم Private Sub CommandButton5_Click() Application.Visible = False On Error Resume Next Login_screen.Show Application.Wait Now + TimeValue("00:00:3") Login_screen.Hide UserForm1.Show UserForm1.Repaint Application.Wait Now + TimeValue("00:00:3") UserForm1.Hide Application.Visible = True End On Error GoTo 0 End Sub هذا كود الصوت Private Sub CommandButton13_Click() WindowsMediaPlayer3.Controls.Play End Sub

للرفع

السلام عليكم و رحمة الله و بركاتة تفضل اظهار الرقم الحقيقي دون كسور.xlsx

اخواني الخبراء كيف اجعل WindowsMediaPlayer1 الصوت يعمل و يوقف اتوماتيكيا عند فتح يوزرفورم مهما كان عدد اليوزرفورم Private Sub OptionButton1_Click() WindowsMediaPlayer1.URL = ThisWorkbook.Path & "سورة الإخلاص\" Application.Wait (Now + TimeValue("0:00:45")) WindowsMediaPlayer1.Controls.Play End Sub

السلام عليكم و رحمة الله و بركاتة اخواني الخبراء هل يمكن اضافة الصوت WindowsMediaPlayer1 فى UserForm2و UserForm3 Sub View_images() Application.Visible = False On Error Resume Next Login_screen.Show Application.Wait Now + TimeValue("00:00:3") Login_screen.Hide UserForm1.Show UserForm1.Repaint Application.Wait Now + TimeValue("00:00:3") UserForm1.Hide UserForm2.Show UserForm2.Repaint Application.Wait Now + TimeValue("00:00:9") UserForm2.Hide UserForm3.Show UserForm3.Repaint Application.Wait Now + TimeValue("00:00:9") UserForm3.Hide Application.Visible = True End On Error GoTo 0 End Sub

المطلوب هو B11 الى B10000هو تاريخ الوارد و الصرف في حالة عدم وجود الوارد فى نفس يوم يترك فاضي c-d-e في حالة عدم وجود الصرف فى نفس يوم يترك فاضي f-g-h المطلوب تاريخ الصرف

السلام عليكم و رحمة الله و بركاتة جزاك الله خير الجزاء المطلوب فقط جلب التاريخ الصرف , B11 الى B10000هو تاريخ الوارد و الصرف في حالة عدم وجود الوارد فى نفس يوم يترك فاضي c-d-e في حالة عدم وجود الصرف فى نفس يوم يترك فاضي f-g-h برنامج المستودع 4.xlsb

السلام عليكم و رحمة الله و بركاتة اخواني الخبراء هل يوجد خطا فى كود بطاقة الصنف B11 تاريخ بد البرنامج و هو ثابت I11 رصيد بد البرنامج و هو ثابت 0 I12 الى I10000 هو رصيد الصنف و هو ثابت و معادلة هو (=I11+D12-G12) B11 الى B10000هو تاريخ الوارد و الصرف في حالة عدم وجود الصرف فى نفس يوم يترك فاضي التاريخ الوارد الصرف الرصيد رقم الفاتورة الكمية القيمة رقم الفاتورة الكمية القيمة 2023/01/01 0 02/01/2023 100001 100 د.إِ.1500 90 03/01/2023 200001 10 د.إِ.1500 180 13/01/2023 200002 10 د.إِ.1500 270 23/01/2023 200003 10 د.إِ.1500 360 03/02/2023 200004 10 د.إِ.1500 350 13/02/2023 200005 10 د.إِ.1500 340 23/02/2023 200006 10 د.إِ.1500 340 02/04/2023 100002 100 د.إِ.1500 340 02/07/2023 100003 100 د.إِ.1500 340 02/10/2023 100004 100 د.إِ.1500 برنامج المستودع 4.xlsb

أ / محمد صالح Ali Mohamed Ali محمد هشام. جزاكم الله خير الجزاء

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

السلام عليكم و رحمة الله و بركاتة برنامج حساب الوزن من تصميمي حساب الوزن.xlsx

السلام عليكم و رحمة الله و بركاتة اخواني الخبراء ارجوا مساعدتي Private Sub CommandButton2_Click() Sheet6.Range("k2").Value = Sheet5.Range("F7").Value Dim x As Integer x = Sheet6.Range("L2").Value Sheet6.Cells(x, "B").Value = Sheet5.Range("B7").Value Sheet6.Cells(x, "C").Value = Sheet5.Range("F7").Value Sheet6.Cells(x, "D").Value = Sheet5.Range("B9:B28").Value Sheet6.Cells(x, "e").Value = Sheet5.Range("d9:d28").Value Sheet6.Cells(x, "D").Value = Sheet5.Range("B9:B28").Value MsgBox "تم تعديل بيانات الفاتورة بنجاح" End Sub فكود تديل الفاتورة برنامج المستودع.xlsb

السلام عليكم و رحمة الله و بركاتة التاريخ الوارد الصرف الرصيد رقم الفاتورة الكمية القيمة رقم الفاتورة الكمية القيمة 2023/01/01 0 02/01/2023 100001 100 د.إِ.1500 90 03/01/2023 200001 10 د.إِ.1500 180 13/01/2023 200002 10 د.إِ.1500 270 23/01/2023 200003 10 د.إِ.1500 360 03/02/2023 200004 10 د.إِ.1500 350 13/02/2023 200005 10 د.إِ.1500 340 23/02/2023 200006 10 د.إِ.1500 340 02/04/2023 100002 100 د.إِ.1500 340 02/07/2023 100003 100 د.إِ.1500 340 02/10/2023 100004 100 د.إِ.1500 340 هذا الشكل مطلوب فقط التاريخ الصرف

السلام عليكم و رحمة الله و بركاتة اخواني الخبراء هل يوجد خطا فى كود بطاقة الصنف B11 تاريخ بد البرنامج و هو ثابت I11 رصيد بد البرنامج و هو ثابت 0 I12 الى الشيت I1000 (=I11+D12-G12) B11هو تاريخ الوارد و الصرف في حالة عدم وجود الصرف فى نفس يوم يترك فاضي مشاركة السابقة نموذج للمطلوب Private Sub CommandButton1_Click() Dim a, b, v, wsItems As Worksheet, wsWared As Worksheet, wsSarf As Worksheet, sh As Worksheet, lr As Long, i As Long, k As Long Application.ScreenUpdating = False Set wsItems = ThisWorkbook.Worksheets("sheet4") Set wsWared = ThisWorkbook.Worksheets("sheet6") Set wsSarf = ThisWorkbook.Worksheets("sheet8") Set sh = ThisWorkbook.Worksheets("sheet9") sh.Range("A12:I" & Rows.Count).ClearContents lr = Application.Max(12, sh.Cells(Rows.Count, 3).End(xlUp).Row + 1) If sh.Range("C8").Value = "" Then Exit Sub v = Application.Match(sh.Range("C8").Value, wsItems.Columns(2), 0) If Not IsError(v) Then sh.Cells(8, 3).Resize(1, 4).Value = wsItems.Cells(v, 2).Resize(1, 4).Value sh.Range("I11").Value = wsItems.Cells(v, 6).Value sh.Range("B11").Value = DateSerial(Year(Date), 1, 1) End If k = 0 a = wsWared.Range("A9:I" & wsWared.Cells(Rows.Count, 3).End(xlUp).Row).Value ReDim b(1 To UBound(a, 1), 1 To 5) For i = LBound(a) To UBound(a) If a(i, 4) = sh.Range("C8").Value Then k = k + 1 b(k, 1) = a(i, 1) b(k, 2) = a(i, 2) b(k, 3) = a(i, 3) b(k, 4) = a(i, 8) b(k, 5) = a(i, 9) End If Next i If k > 0 Then sh.Range("A" & lr).Resize(k, UBound(b, 2)).Value = b k = 0 a = wsSarf.Range("A9:I" & wsSarf.Cells(Rows.Count, 3).End(xlUp).Row).Value ReDim b(1 To UBound(a, 1), 1 To 3) For i = LBound(a) To UBound(a) If a(i, 4) = sh.Range("C8").Value Then k = k + 1 b(k, 1) = a(i, 3) b(k, 2) = a(i, 8) b(k, 3) = a(i, 9) End If Next i If k > 0 Then sh.Range("F" & lr).Resize(k, UBound(b, 2)).Value = b Application.ScreenUpdating = True End Sub برنامج المستودع.xlsb

استاذ محمد هشام زادك الله علما وفهما و حفظك الله ورعاك وجعل الجنة مأواك

جَزَاكَ اللَّهُ خَيْرًا الشيت 10 ممتاز و لكن شيت 4 لا يستجيب للامر برنامج المستودع.xlsb

استاذ محمد هشام بارك الله فيك و زادك الله علما و جزاك الله خير الجزاء

السلام عليكم و رحمة الله و بركاتة اخواني ارجوا مساعدتي في استبدال المعادلة بالكود خاص بالوارد و الصرف للمستودع بشرط تاريخين و يتغير اتوماتيكيا عند تغيير التواريخ في ورقة 4 عمود الوارد G في شيت 4 بشرط التاريخ البداية F7 و النهاية I7 و عمود الصرف H في شيت 4 بشرط التاريخ البداية F7 و النهاية I7 عند كل تغيير في ورقة 4 وكذلك نفس الكود عمود الوارد H في شيت 10 بشرط التاريخ البداية E5و النهاية G5و عمود الصرفJ في شيت 10 بشرط التاريخ البداية E5و النهاية G5 شاشة الدخول مع صلاحيات 5.xlsb

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

جزاك الله خير على الرد و الاهتمام جعله الله ذلك فى موازين حسناتك عمود رصيد البداية الجرد في شيت 4 يتم نسخ بياناته الى رصيد البداية f عمود الكمية شيت 10 عمود الرصيد الي هو عمود ( L ) شيت 4 الى عمود كلفة المخزون في بداية الفترة H شيت 11 عمود الرصيد الي هو تاريخ نهاية الفترة دوران المخزون يتم نسخه الى عمود كلفة المخزون في نهاية الفترة Hالشيت 11 عند كل تغيير في ورقة 4