كل الانشطه

السلام عليكم .. استاذى الفاضل الكود السابق يقوم بمسح الورقة قبل الترحيل وبالتالى ما سيتم اظهاره هو الترحيل الخاص بالاسبوع الحالى فقط اما الترحيلات السابقة فلن تظهر والمطلوب ان كل اسبوع يتم ترحيله لا يتم مسح الترحيلات السابقة واظهار النتائج ( هناك شكلين كما ييسر ) كما بالملف التالى Book222بالتعديل.xls

ما شاء الله عليك أخي @طير البحر ، سأستمتع بلمساتك والتعديلات غداً إن شاء الله 🤗 بالنسبة لهذا الطلب فهو من صلاحيات الأساتذة - لا الحصر - أذكر منهم:- @Moosak و @jjafferr و معلمنا الفاضل اعاده الله من سفره سالما غانماً @ابوخليل ... والكثيرين الذين نسعد بوجودهم معنا من إدارة المنتدى 🥰.

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

رغم ان العنوان لا يمثل المطلوب وهذا مخالف لترتيبات وقوانين المنتدى ..... لكن بعد الدمج ماهو مصير السجل الثاني ( هل يحذف أم يبقى في الجدول ) .......

تفضل يا غالى دقة الشاشة 768×1024

الاخ المحترم @Foksh قمت بتعديل نهائي لما يلزم مع الاستفادة من خيار اعادة التشغيل المقدم من طرفكم وضبط كل شئ دون التأثير على الخيارات او اجراء تغييرات غير محسوبة كما تم اضافة زر اعادة تشغيل كخيار للشريط العائم ونموذج الارضية والنموذج الرئيسي ارجو ان ينال الامر اعجابك وكنت اتمنى استبدال الملف الرئيسي باول البوست dboptions.rar

اتأسف لحضرتك لأنتظارك زشكرأ لتعبك المطلوب دمج السجلين بسجل واحد مع تحريك البيانات من السجل الثانى الى مواضع الجقول الموضحة بالصورة

الأخ @اشرف السيد يوسف منذ ساعة وأنا انتظرك لما تنزل موضوع من اربع ساعات على الاقل كل ساعة ادخل اتفقد الوضع

اسف اخي لم انتبه فعلا على العموم حل الاستاد حسونة سوف يلبي المطلوب بالتوفيق.

انت حضرتك اشتريت بضاعة بالجملة عددها 30 قطعة وبعت منها 10 قطاعى كم يتبقى عندك وبعدين بعت 2 جملة كم يتبقى عندك بعد العملية الاولى والثانية (هذا هو الرصيد التراكمى) وهكذا بالنسبة لمرتجع الشراء والبيع

تقصد ان هدا الشكل لا يناسبك هل قمت بتجربة هدا Sub test() Dim lCol As Long, MyRng As Range Set desWS = ActiveSheet: Set ws = Sheet2 If Len(desWS.[CA328].Value) = 0 Then Exit Sub ws.Cells.Clear For i = desWS.[CA328] To desWS.[CE328]: desWS.[BU331].Value = i Set MyRng = desWS.[BW330:CK372] Application.ScreenUpdating = False MyRng.Copy If ws.[D9] = "" Then MyRng.Copy With ws.[c5] .PasteSpecial xlPasteValues: .PasteSpecial xlPasteFormats End With Else lCol = ws.Cells(9, ws.Columns.Count).End(xlToLeft).Column + 5 MyRng.Copy With ws.Cells(5, lCol) .PasteSpecial xlPasteValues: .PasteSpecial xlPasteFormats End With End If Application.CutCopyMode = False Application.ScreenUpdating = True Next i End Sub 2024-04-11 الفواتير من 2024-04-05 الى.pdf

تفضل لان الخليه f3 بها تاريخ ظهر لك هذا الخطأ sNewFilePath = ThisWorkbook.Path & "\" & Replace(Range("F3").text, "/", "-") & ".pdf"

@محمد هشام. الملف مرفق بالفعل كود.xlsb

الحقيقة اليوم إجازة فعلاً ده من جهة ، ومن جهة تانية انا دخت بعد ما قرأت مشاركتك السابقة والحقيقة ما فهمتش كتير يعني 😬 ، شكلي بعد الغدا مخي استوعب انه اليوم إجازتي 😅

انا عارف ان حضرتك اجازة اليوم ولما تروح الشغل يكون لنا لقاء

اخي اشرف يا ريت توضح طلبك مشان نقدر نساعدك ايش المطلوب ؟؟ ايش يعني دمج السجلات ؟؟ يا ريت توضح الفكرة اكثر

ربما لو قمت بارفاق الملف سوف تكون الامور اوضح تفضل جرب 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.xlsb

الله ينفع بك أستاذنا محمد هشام تم تعريف المتغيرات حتى لا تحصل مشاكل مستقبلية تم إضافة جزئية الحصول على مسار سطح المكتب للمستخدم الحالي بحيث ما تتعب مستقبلا في نقل الملف لكمبيوتر آخر 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 Sub

خطأ في الكود

جرب هدا 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 Sub

اليلام عليكم اساتذتي الافاضل ورحمة الله وبركاته طلبي مشروح داخل ملف الاكسل بالتفصيل الممل مع وافر التحايا 1 - يكون حقل اسم المادة قائمة منسدلة وفيها اكتب انواع الاثاث 2 - اخفاء حقل السعر بعد ان اقوم بتثبيت السعر فيه 3 - عندما افتح الملف لاتظهر البيانات فقط تظهر الحقوق فارغة 4 - عندما اشارك هذا الملف مع الاصدقاء فقط يظهر لهم حقل اسم المادة والكمية وحق المبلغ فارغين من البيانات لكي يقوم المستخدم لهذا الملف بأدخال بيانات جديدة وكل مايدخل زبون اخر تظهر له هذه الحقوق فارغة لكي يدخل بيانات جديدة وهذا الملف في المرفقات ex2.xlsx

بارك الله فيكم استاذى الكريم جعله اللى فى ميزاتن حسناتكم

السلام عليكم الرجاء المساعة فى الملف المرفق الاحصاء اقل من فدان اقل من 2 فدان اقل من 3 اقل من 5 اقل من 10 للرفع.xlsx بارك الله فيكم

ادا كنت قد فهمت طلبك بشكل صحيح يمكنك الحصول على دالك بتفعيل هدا السطر حيث يتم فلترة البيانات بشرط عمود المفتاح ما بين التواريخ الموجودة في الخلايا D4 و F4 '******* اظافة شرط بين تاريخين rng.AutoFilter field:=3, _ Criteria1:=">=" & CDbl(WS.[D4]), Operator:=xlAnd, _ Criteria2:="<=" & CDbl(WS.[F4]) اما بالنسبة ل كود عمل نسخة احتياطية كل عشر دقائق ضع الكود التالي في module Sub SaveBackup() Dim filePath$,folderName$,copyName$ Dim ThisBook As Workbook : Set ThisBook = ThisWorkbook 'مسارالحفظ ' filePath = "D:": 'اسم مجلد الحفظ folderName = "BACKUPS" With Application .ScreenUpdating = False .DisplayAlerts = False On Error Resume Next 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" 'حفظ المصنف الرئيسي ' ActiveWorkbook.Save .DisplayAlerts = True .ScreenUpdating = True End With End Sub وفي حدث Private Sub Workbook_Open Private Sub Workbook_Open() Call SaveBackup End Sub تفضل جرب المرفق التالي بالتوفيق فلترة وحفظ.xlsm

خطأ