محمد حسن المحمد

جزاكم الله خيراً ....يرجى تجربة هذا الملف إن كان يعمل على 64 بت أم لا ؟!... برنامج المخازن.xlsm

الله يرحم أمواتكم وأموات المسلمين ...إنا لله وإنا إليه راجعون...

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

برجاء تنزيله هنا أخي الكريم لأنني لا أستطيع تجربته حتى بعد التنزيل لأن النظام لدي 32بت ولكم الشكر

هل تمت تجربته من قبلكم أخي الكريم لأني جربت كود شبيه به ولم يفلح

وجزاكم بمثل مادعوتم أخي الكريم النظام لدي يستخدم نواة 32 بت أما عندك فهي 64 بت وهو بحاجة تحديث الديكلير كما ترى وأنا بصراحة استخدمت كوداً لأحد الأساتذة الكرام يقوم بالتحويل من 32 إلى 64 بت ولم يفلح للأسف ، كنت قد نصحني منذ مدة أحدهم بحذف ما هو مكتوب بالأحمر ولا أدري إن كانت ستنجح هذه الطريقة. بانتظار أحد الأساتذة الكرام الذين لهم باع طويل في الأكواد والـ VBA ... تقبل تحياتي العطرة.

جزاكم الله خيراً

جزاكما الله خيراً أخويّ الكريمين علي محمد علي وأحمد يوسف على التفاعل البناء في المنتدى الكريم

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

وجزاكم بمثل ما ذكرتم أخي الكريم @Ali Mohamed Aliوأنا بدوري اعتبرتها أحسن إجابة كرماً منك إذا أنت أكرمت الكريم ملكته وإن أنت أكرمت اللئيم تمردا تقبل تحياتي العطرة.

تم التعديل على البرنامج كونه تالف تقريباً برنامج المخازن.xlsm

لا شكر على واجب ...حياكم الله ... لكن بهذه الحالة يفضل إرفاق ملف به بعض البيانات((الوهمية)) لتتم معالجتها على بينة وليس ما تخطط لعمله فحسب فما تدركه أو تتخيله لا ينطبق تماماً على ما يفكر به الآخرون.. تقبل تحياتي العطرة والسلام عليكم ورحمة الله وبركاته

وجزاكم بمثل ما دعوتم أخي الكريم @Osama-2020 الحمد لله الذي بنعمته تتم الصالحات

لكم شكري وتقديري إخوتي الكرام @Ali Mohamed Ali و @أحمد يوسف بارك الله فيكم

أشكركم أخي الكريم @Ali Mohamed Ali حسن المتابعة تقبل تحياتي العطرة

وبارك بكم أخي الغالي @إبراهيم ابوليله أرجو أن يكون ما قدمت جزءاً من الحل حيث وجدته من خلال البحث.. تقبل تحياتي العطرة.

أخي الكريم تم فتح شيت جديد لفلترة البيانات ضمنه تم استخدام كود بسيط للفلترة والآخر لمسح البيانات المفلترة كما تم جمع تلقائي لكل عمود في أعلاه ليسهل عليك استخدام ورقة ثانية لتنظيم ما تريد أما التصفية حسب التاريخ تم توسيع نطاق دالة VLOOKUP لتشمل بدء و انتهاء كل فترة ليتم حسابها سواء بالشهر أو ربع أو نصف ...إلخ أرجو أن يكون بداية توجه لمعرفة النتائج التي تريدها.وسيسهل عليك معرفتها بإذن الله تعالى. ربط فلتر الشهر مع معادلة لحساب مبالغ.xlsm

أشكرك أخي الكريم @أحمد يوسف على هذا التفاعل البناء كما أشكر أخي الحبيب أيضاً @Ali Mohamed Ali على مروره العطر والسلام عليكم

السلام عليكم أرجو أن يكون هو المطلوب بناء تسلسل وظيفي بالجداول المحورية.xlsx

لا شكر على واجب أخي الكريم @abouelhassan

وعليكم السلام ورحمة الله وبركاته أخي الكريم @إبراهيم ابوليله المحترم أما عن الطلب الأول فقد بحثت عنه وتحققت من أدائه أرجو أن تكون به الفائدة الأكواد منقولة من خلال البحث في النت للأمانة. أما عن الطلب الثاني فالإخوة الكرام أهل لذلك وزيادة (بكم البركة).... تقبل تحياتي العطرة. Option Explicit Dim Status As String Sub Main() Dim LastRow As Long, iRow As Long Dim FolderPath As String Dim wsApp As Worksheet Set wsApp = ThisWorkbook.Worksheets("App") With wsApp LastRow = .Cells(Rows.Count, "B").End(xlUp).Row FolderPath = .Range("FolderPath").Value If Dir(FolderPath, vbDirectory) = vbNullString Then MsgBox "Invalid Base Folder Provided.", vbExclamation Exit Sub End If If 6 > LastRow Then MsgBox "No item provided.", vbExclamation Exit Sub End If For iRow = 6 To LastRow If .Cells(iRow, "B").Value <> "" Then CreateFolder .Cells(iRow, "B").Value, FolderPath .Cells(iRow, "C").Value = Status End If Next iRow End With MsgBox "All folder created successfully.", vbInformation Set wsApp = Nothing End Sub Private Sub CreateFolder(ByVal SubFolder As String, ByVal BaseFolder As String) Dim strTemp As String Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Status = "" strTemp = CleanFolderName(SubFolder) If fso.FolderExists(BaseFolder & "\" & strTemp) Then Status = "Folder Exists Already" Else If Len(strTemp) > 0 Then MkDir BaseFolder & "\" & strTemp Status = "Success" End If End If Set fso = Nothing End Sub Public Function CleanFolderName(ByVal FolderName As String) As String Dim i As Long Dim strTemp As String For i = 1 To Len(FolderName) Select Case Mid(FolderName, i, 1) Case "/", "\", ":", "?", "<", ">", "|" strTemp = strTemp & "_" Case Else strTemp = strTemp & Mid(FolderName, i, 1) End Select Next i CleanFolderName = strTemp End Function إبراهيم أبو ليلة.xlsm

بارك الله بكم أخي الكريم

أحسن الله إليك وجزاك بمثل مادعوت لي وزيادة آمين أخي الكريم @فوزى فوزى تقبل تحياتي العطرة

شكراً على مروركم العطر أخي الكريم

أشكركم على تثبيت الموضوع أساتذتي الكرام مسؤولي منتدى أوفيسنا العريق بارك الله بكم وأحسن إليكم ....آمين