نجوم المشاركات
Popular Content
Showing content with the highest reputation on 26 أبر, 2024 in مشاركات
-
اسف اخي لم انتبه فعلا على العموم حل الاستاد حسونة سوف يلبي المطلوب بالتوفيق.2 points
-
تفضل لان الخليه f3 بها تاريخ ظهر لك هذا الخطأ sNewFilePath = ThisWorkbook.Path & "\" & Replace(Range("F3").text, "/", "-") & ".pdf"2 points
-
الله ينفع بك أستاذنا محمد هشام تم تعريف المتغيرات حتى لا تحصل مشاكل مستقبلية تم إضافة جزئية الحصول على مسار سطح المكتب للمستخدم الحالي بحيث ما تتعب مستقبلا في نقل الملف لكمبيوتر آخر Sub SaveBackup() Dim filePath As String Dim FolderName As String Dim copyName As String Dim ThisBook As Workbook Set ThisBook = ThisWorkbook ' هنا سيتم الحصول على مسار الجهاز filePath = Environ("UserProfile") & "\Desktop" FolderName = "BACKUPS" With Application .ScreenUpdating = False .DisplayAlerts = False copyName = filePath & "\" & FolderName & " " & Format(Now, "dd-mmmm-yyyy") If Dir(copyName, vbDirectory) = "" Then MkDir copyName ThisBook.SaveCopyAs copyName & "\" & ThisBook.Name & " " & _ Format(Now, "dd-mmmm-yyyy-HH-MM-SS") & ".xlsm" Application.OnTime Now + TimeValue("00:10:00"), "SaveBackup" .DisplayAlerts = True .ScreenUpdating = True End With End Sub2 points
-
جرب هدا Private Sub TextBox1_Change() Set WS = Sheets("Sheet1") On Error Resume Next If WS.TextBox1.Text = Empty Then WS.[A8:L8].AutoFilter lr = WS.Cells(WS.Rows.Count, "L").End(xlUp).Row Clé = "*" & Replace(WS.TextBox1.Text, " ", "*") & "*" If WS.TextBox1.Text <> "" Then Set rng = WS.Range("A8:L" & lr) '****المفتاح***** rng.AutoFilter field:=12, Criteria1:=Clé '******* اظافة شرط بين تاريخين rng.AutoFilter field:=3, _ Criteria1:=">=" & CDbl(WS.[D4]), Operator:=xlAnd, _ Criteria2:="<=" & CDbl(WS.[F4]) Else WS.[A8:L8].AutoFilter End If End Sub Sub test() Dim desWS As Worksheet: Set desWS = Sheets("Sheet1") Dim dest As Worksheet: Set dest = printing Application.ScreenUpdating = False If Sheets("Sheet1").TextBox1.Text = "" Then Exit Sub rng = Application.WorksheetFunction.Subtotal(3, desWS.Range("L9:L10000")) If rng = 0 Then: MsgBox "لا توجد بيانات للحفظ", vbInformation, "تم إلغاء الإجراء": Exit Sub Set a = desWS.Range("A8", desWS.Range("A" & desWS.Rows.Count).End(xlUp)) ' For r = 1 To 11 لغاية عمود الملاحظات For r = 1 To 12 'مفتاح ' لغاية عمود Set a = Union(a, Intersect(a.EntireRow, a.Columns(r))) Next r Msg = MsgBox("؟" & " " & "PDF " & ":" & " تصدير التقرير بصيغة", vbYesNo, dest.Name) If Msg <> vbYes Then Exit Sub dest.Range("A3:L" & dest.Rows.Count).Clear a.Copy Destination:=dest.Range("A6") 'حفظ PDF Save_As_PDF2 On Error Resume Next desWS.AutoFilter = False Sheets("Sheet1").TextBox1.Text = "" Application.ScreenUpdating = True End Sub فلترة وحفظ PDF +EXCEL V2.xlsm2 points
-
على قددر علمي اقدم لكم هذه الهدية للتحكم فى خيارات العرض والتشغيل كما هو موضح فى الصورة المرفقة اضفت نموذج ارضية وشريط ادوات عائم يمكنتك تطويره يلاحظ ان خاصية autocompact معطلة فى كلا الحالتين يمكنك تفعيلها تقبلوها منى خالصة لوجه الله تعالى وارجوا امدادى بخصائص اخرى حبث انى حديث عهد باكسس ولا تنسوا التقييم والرأي ولفت نظرى لاى خطأ كلمة السر 123 يمكنك تعديلها dboptions.rar1 point
-
1 point
-
الأخ @اشرف السيد يوسف منذ ساعة وأنا انتظرك لما تنزل موضوع من اربع ساعات على الاقل كل ساعة ادخل اتفقد الوضع1 point
-
انا عارف ان حضرتك اجازة اليوم ولما تروح الشغل يكون لنا لقاء1 point
-
ربما لو قمت بارفاق الملف سوف تكون الامور اوضح تفضل جرب Sub General() Dim LatR As Long: Dim sFile As String Set WS = ActiveSheet: sFile = [F3].Value On Error Resume Next LatR = Range("A:A").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row With WS .PageSetup.PrintArea = Range("A2:AF" & LatR).Rows.SpecialCells(xlCellTypeVisible).Address .VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1 sNewFilePath = ThisWorkbook.Path & "\" .ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=sNewFilePath & sFile & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End With Sheets("النتيجة2").Select End Sub TEST PDF.xlsb1 point
-
جرب هدا Dim sFile As String sFile = Range("F3").Value sNewFilePath = ThisWorkbook.Path & "\" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=sNewFilePath & sFile & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False مجرد تخمين ربما يفيدك Sub General() Dim LatR As Long: Dim sFile As String Set WS = ActiveSheet: sFile = [F3].Value LatR = Range("a:a").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row WS.PageSetup.PrintArea = Range("A2:AF" & LatR).Rows.SpecialCells(xlCellTypeVisible).Address WS.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1 sNewFilePath = ThisWorkbook.Path & "\" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=sNewFilePath & sFile & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Sheets("النتيجة2").Select End Sub1 point
-
السلام عليكم ورحمة الله وبركاته وبها نبدأ عدل السطر الى sNewFilePath = ThisWorkbook.Path & "\" & Range("F3").text & ".pdf"1 point
-
1 point
-
نفس الفكرة ، إلا إذا اختلفت صلاحيات المسؤولين حينهم سيكون العمل أوسع بكثير ، طبعاً بالتسلسل حسب صلاحيات المسؤولين 🤔1 point
-
للأسف لم أواجه مثل هذه المشكلة ، ولكن جرب حذف الأوفيس وإعادة تثبيته مرة أخرى ، عل المشكلة في التحديثات الجديدة 🤔 وجهة نظر1 point
-
الخير والبركة فيكم يا صديقي.. طبعاً حسب ما تصورت الفكرة من كلامك سيكون هناك واجهة للجداول وتكون مشتركة بين المدير له واجهة نماذج والمسؤول 1 له واجهة اخرى . وكلاهما سيشترك في الجداول المخصصة له مع فكرة التنبيه لكل طرف منهم بوجود إشعار أو كتاب يحتاج للموافقة أو الرد .1 point
-
1 point
-
1 point
-
1 point
-
بانتظار هذا السؤال 😅 اخي المشروع ضخم الى حد ما مقارنة مع المتطلبات ، لذا يستلزم بداية إنشاء الجداول والنماذج والاستعلامات والتقارير والأكواد بلا شك . وقد يستهلك وقت كثير ، ولكن سأحاول بجهودك إنشاء الجداول أولا والتخطيط لذلك. ولكن غداً إن شاء الله سأحاول رسم الفكرة والبدء بتنفيذها معاك 😊1 point
-
1 point
-
1 point
-
😅 الإجابة على ما تفضلت به أخي @Zooro1 في السؤال ، هي نعم . أمااا في التفاصيل الباقية فهي ممكنة إلى حد ما .1 point
-
1 point
-
وكملاحظة لم اقم بتعديلها وتركتها لك لاكتشافها 😉 1. إيقاف قوائم اكسيس ، وإيقاف القوائم المختصرة تعمل بالعكس 2. ستجد بعض رسائل الخطأ قد ظهرت وتحتاج الى تلافيها حسب الكود الخاص بك ، فلم أطلع كثيراً على تسلسل الأحداث في الأكواد بتمعن 😊1 point
-
1 point
-
اخي الكريم @اشرف السيد يوسف ، قم بما يلي :- انشئ استعلام وقم باختيار الجدول Table1 ، ثم قم بإضافة جميع الحقول ( الاسم ، العمل1 ، العمل 2 ..... إلخ ) . ثم اعمل تجميع واجعل جميع الحقول MAX باستثناء حقل الاسم اتركه Group By. وهذا مثالك أيضاً مرفق.accdb 🤗1 point
-
استاذي محمد هشام. ربنا يكرمك يارب على كرم حضرتك الكبيير ويارب يجعل ما تفعله في ميزان حسناتك .. الحمد لله عرفت اشغله حضرتك معلش والله أنا آسف اخر حاجة انا زهقتك معايا هل ممكن تحطلي البحث بالمفتاح في شيت الأنشطة بجانب البحث بتاريخ لان SHEET1 انا بحط فيه البيانات بتاعتي كلها بتاعة السنة لكن في شيت الانشطة ممكن ادور من تاريخ الى تاريخ أو ممكن استخدم المفتاح علشان ممكن ابحث مثلا على الانشطة المتعلقة مثلا بذوي الهمم التي تمت من تاريخ كذا الى تاريخ كذا وياريت طبعا عند التصدير مايظهرش عامود المفتاح وياريت حضرتك معلش كود عمل نسخة احتياطية كل عشر دقائق في D:/BACKUPS للملف كله محمد هشام. ربنا يحفظ حضرتك يا رب العالمين1 point
-
اخي الكريم @طير البحر ، أرجو ان تقبل هذه التعديلات التي أجريتها والتي لم تمس الوظائف في مشروعك ، وإنما اعتبرها لمساتي بطريقتي المتواضعة 🤗 اولا تم توظيف كود Restart بحيث يتم تنفيذه اذا تم التعديل على الوظائف التي أشرت إليها بصورة 💡 - باستخدام ميزة الـ Tag - والتي تتطلب إعادة التشغيل للبرنامج وذلك بإضافة وظيفتين في نموذج dboptions واحدة عند الفتح والأخرى يتم استدعائها عند تنفيذ الزر تطبيق . فإذا لم يتم تغيير اي من هذه الوظائف التي تتطلب إعادة التشغيل فسيتم تطبيق كودك بشكل عادي كالسابق ، أما اذا تم تغيير اي قيمة فسيطلب منك اعادة التشغيل للبرنامج. بالاضافة الى اجراء إضافة بسيطة في مديول myoptions وذلك بتغيير قيمة gogo في الجدول وإعادتها إلى True في حال تم تغييرها الى False قبل تنفيذ إعادة التشغيل للبرنامج وذلك حتى لا يتم التأثير على عموم الكود الخاص بك . الق نظره واخبرني بالنتيجة 🤗 New_Options.accdb1 point
-
1 point
-
1 point
-
بارك الله فيك استاذنا الجليل شحاته وجزاك الله كل خير على هذه الهدية الممتازة وشكراً لجهودكم الكريمة1 point
-
شوف عزيز مثل اى برنامج بيع وشراء شراء 40 جملة يكون التراكمى 40 شراء 35 قطاعى يكون التراكمى 47 لان الـ 35 / عدد الوحدات وهى 5 يكون الناتج 7 بيع 7 جملة يكون التراكمى 40 بيع 5 قطاعى يكون التراكمى 39 عشان 5/5 تكون التيجة 1 مرتجع شراء 9 جملة يكون التراكمى 30 مرتجع شراء 5 قطاعى يكون التراكمى 29 عشان تحويل قطاعى الى جملة مرتجع بيع 3 يعنى (بالاضافة) يكون التراكمى 32 الشراء نضيف البيع نخصم ومرتجع بيع (نضيف) مرتجع شراء (نطرح) يعنى (الشراء - البيع - مرتجع الشراء + مرتجع البيع) وكله حسب الوحدة (جملة او قطاعى) / عدد الوحدات فى حالة القطاعى معلش كلام كثير لعلى اكون وصلت الفكرة0 points
-
0 points