ahmedabuzena قام بنشر أغسطس 15 مشاركة قام بنشر أغسطس 15 السلام عليكم ورحمة الله وبركاته برجاء عايز بالضغط على الزر واختيار التاريخ يتم التغير في العامودين هو يعمل على عامود واحد فقط SHADY TIME TABLE 1.xls رابط هذا التعليق شارك More sharing options...
AbuuAhmed قام بنشر أغسطس 15 مشاركة قام بنشر أغسطس 15 (معدل) فقط أدخل تاريخ الشهر في الخلية "I4" SHADY TIME TABLE 1_01.xls تم تعديل أغسطس 15 بواسطه AbuuAhmed تنقيح المرفق 3 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر أغسطس 15 مشاركة قام بنشر أغسطس 15 وعليكم السلام ورحمة الله تعالى وبركاته رغم انه في وجهة نظري ان الاقتراح المقدم من اخينا @AbuuAhmed افضل واسهل وينفد المطلوب دون الحاجة لاستخدام صندوق الادخال في حالة كانت لك رغبة لاستخدام نفس الطريقة يمكنك تجربة هدا Sub my_date() Dim xDate As String, i As Long Set sh = Sheets("ELRASHIDY") xDate = InputBox("insert date format month/year ", "insert month date", "MM/YYYY") If StrPtr(xDate) = 0 Then Exit Sub If Not IsDate(xDate) Or Not (xDate) Like "##/####" Then _ MsgBox "يرجى التحقق من تاريخ الادخال", vbExclamation: Exit Sub Application.ScreenUpdating = False With sh .Range("B6:C36,N6:O36").ClearContents tmp = DateSerial(Year(xDate), _ Month(xDate) + 1, 1) - DateSerial(Year(xDate), Month(xDate), 1) Range("B6,N6,I4").Value = DateSerial(Year(xDate), Month(xDate), 1) [B6].AutoFill Destination:=[B6].Resize(tmp), Type:=xlFillDays [N6].AutoFill Destination:=[N6].Resize(tmp), Type:=xlFillDays For i = 6 To sh.Cells(Rows.Count, "b").End(xlUp).row ColDates = Range("b" & i).Value DayName = Format(ColDates, "dddd") With Union(sh.Range("C" & i), sh.Range("O" & i)) .Value = DayName End With Next i End With Application.ScreenUpdating = True End Sub SHADY TIME TABLE 1_V2.xls 3 رابط هذا التعليق شارك More sharing options...
mahmoud nasr alhasany قام بنشر أغسطس 15 مشاركة قام بنشر أغسطس 15 احسنت استاذنا / محمد هشام. احسنت استاذنا / AbuuAhmed. رابط هذا التعليق شارك More sharing options...
ahmedabuzena قام بنشر أغسطس 15 الكاتب مشاركة قام بنشر أغسطس 15 ما شاء الله مش اختار مين افضل اجابة الاثنين افضل من بعض جزاكم الله خيرا عندي استفسار ليه في الطباعة بيظهر اول جدول فقط رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر أغسطس 15 أفضل إجابة مشاركة قام بنشر أغسطس 15 (معدل) جرب هدا Sub Print_Tbl() Dim lr As Long Set WS = Sheets("ELRASHIDY") Application.ScreenUpdating = False With WS .ResetAllPageBreaks lr = WS.Columns("B:X").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Application.PrintCommunication = False With WS.PageSetup .PrintArea = WS.Range("B2:X" & lr).Address .FitToPagesWide = 1 .FitToPagesTall = 1 End With End With Application.PrintCommunication = True Application.ScreenUpdating = True ActiveWindow.SelectedSheets.PrintPreview 'WS.PrintOut Copies:=1 End Sub اخي لقد حاولت حدف الاعمدة الغير مستخدمة مما سيجبرني على تعديل الكود السابق بما يناسب التصمييم الجديد Sub my_date() Dim xDate As String, i As Long Set sh = Sheets("ELRASHIDY") Do xDate = InputBox("insert date format month/year ", "insert month date", "MM/YYYY") If StrPtr(xDate) = 0 Then Exit Sub If xDate = "MM/YYYY" Then MsgBox "يرجى ٌإدخال التاريخ", 48 Loop While xDate = "MM/YYYY" If Not IsDate(xDate) Or Not (xDate) Like "##/####" Then _ MsgBox "يرجى التحقق من التاريخ", 16: Exit Sub Application.ScreenUpdating = False With sh .Range("A6:B36,I6:J36").ClearContents cnt = DateSerial(Year(xDate), Month(xDate), 1) arr = Array("A6", "I6", "G4", "O4") tmp = DateSerial(Year(xDate), _ Month(xDate) + 1, 1) - cnt For i = LBound(arr) To UBound(arr) .Range(arr(i)).Value = cnt Next i [A6].AutoFill Destination:=[A6].Resize(tmp), Type:=xlFillDays [I6].AutoFill Destination:=[I6].Resize(tmp), Type:=xlFillDays For i = 6 To sh.Cells(Rows.Count, "A").End(xlUp).Row ColDates = Range("A" & i).Value DayName = Format(ColDates, "dddd") With Union(sh.Range("B" & i), sh.Range("J" & i)) .Value = DayName End With Next i End With Application.ScreenUpdating = True End Sub Sub PrintTb2() Dim lr As Long Set WS = Sheets("ELRASHIDY") With WS .ResetAllPageBreaks lr = .Cells(.Rows.Count, "a").End(xlUp).Row Application.PrintCommunication = False With WS.PageSetup .PrintArea = WS.Range("A2:O" & lr).Address .FitToPagesWide = 1 .FitToPagesTall = 1 End With Application.PrintCommunication = True WS.PrintPreview 'WS.PrintOut Copies:=1 End With End Sub SHADY TIME TABLE 1_V4.xls تم تعديل أغسطس 16 بواسطه محمد هشام. 2 رابط هذا التعليق شارك More sharing options...
ahmedabuzena قام بنشر أغسطس 15 الكاتب مشاركة قام بنشر أغسطس 15 1 ساعه مضت, محمد هشام. said: اخي لقد حاولت حدف الاعمدة الغير مستخدمة مما سيجبرني على تعديل الكود السابق بما يناسب التصمييم الجديد Sub my_date() Dim xDate As String, i As Long Set sh = Sheets("ELRASHIDY") Do xDate = InputBox("insert date format month/year ", "insert month date", "MM/YYYY") If StrPtr(xDate) = 0 Then Exit Sub If xDate = "MM/YYYY" Then MsgBox "يرجى ادخال التاريخ", vbExclamation Loop While xDate = "MM/YYYY" If Not IsDate(xDate) Or Not (xDate) Like "##/####" Then _ MsgBox "يرجى التحقق من تاريخ الادخال", vbExclamation: Exit Sub Application.ScreenUpdating = False With sh .Range("a6:b36,h6:i36").ClearContents r = DateSerial(Year(xDate), Month(xDate), 1) arr = Array("A6", "H6", "G4") ', "N4" tmp = DateSerial(Year(xDate), _ Month(xDate) + 1, 1) - r For i = LBound(arr) To UBound(arr) .Range(arr(i)).Value = r Next i [A6].AutoFill Destination:=[A6].Resize(tmp), Type:=xlFillDays [H6].AutoFill Destination:=[H6].Resize(tmp), Type:=xlFillDays For i = 6 To sh.Cells(Rows.Count, "A").End(xlUp).Row ColDates = Range("A" & i).Value DayName = Format(ColDates, "dddd") With Union(sh.Range("B" & i), sh.Range("I" & i)) .Value = DayName End With Next i End With Application.ScreenUpdating = True End Sub Sub Impression() Application.ScreenUpdating = False Set WS = Sheets("ELRASHIDY") WS.ResetAllPageBreaks lr = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row ColFin = [1:14].Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column WS.PageSetup.PrintArea = Range("A1", Cells(lr, ColFin)).Address WS.PrintPreview 'WS.PrintOut Copies:=1 Application.ScreenUpdating = True End Sub SHADY TIME TABLE 1_V3.xls 50.5 kB · 1 download الغرض من عمل جدولين اني عايز اطبع ورقة واحدة بها جدولين وبعدين افصل الجدولين عن بعض بس كدة لو حاولت افصل الجدولين حافظه البيانات المكتوبة اعلى جدول رقم واحد رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر أغسطس 15 مشاركة قام بنشر أغسطس 15 (معدل) اخي @ahmedabuzena تم تعديل الكود و اظافة عمود فارغ بين الجداول في المشاركة السابقة تم تعديل أغسطس 16 بواسطه محمد هشام. رابط هذا التعليق شارك More sharing options...
ahmedabuzena قام بنشر أغسطس 16 الكاتب مشاركة قام بنشر أغسطس 16 8 ساعات مضت, محمد هشام. said: جرب هدا Sub Print_Tbl() Dim lr As Long Set WS = Sheets("ELRASHIDY") Application.ScreenUpdating = False With WS .ResetAllPageBreaks lr = WS.Columns("B:X").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Application.PrintCommunication = False With WS.PageSetup .PrintArea = WS.Range("B2:X" & lr).Address .FitToPagesWide = 1 .FitToPagesTall = 1 End With End With Application.PrintCommunication = True Application.ScreenUpdating = True ActiveWindow.SelectedSheets.PrintPreview 'WS.PrintOut Copies:=1 End Sub اخي لقد حاولت حدف الاعمدة الغير مستخدمة مما سيجبرني على تعديل الكود السابق بما يناسب التصمييم الجديد Sub my_date() Dim xDate As String, i As Long Set sh = Sheets("ELRASHIDY") Do xDate = InputBox("insert date format month/year ", "insert month date", "MM/YYYY") If StrPtr(xDate) = 0 Then Exit Sub If xDate = "MM/YYYY" Then MsgBox "يرجى ٌإدخال التاريخ", 48 Loop While xDate = "MM/YYYY" If Not IsDate(xDate) Or Not (xDate) Like "##/####" Then _ MsgBox "يرجى التحقق من التاريخ", 16: Exit Sub Application.ScreenUpdating = False With sh .Range("A6:B36,I6:J36").ClearContents cnt = DateSerial(Year(xDate), Month(xDate), 1) arr = Array("A6", "I6", "G4", "O4") tmp = DateSerial(Year(xDate), _ Month(xDate) + 1, 1) - cnt For i = LBound(arr) To UBound(arr) .Range(arr(i)).Value = cnt Next i [A6].AutoFill Destination:=[A6].Resize(tmp), Type:=xlFillDays [I6].AutoFill Destination:=[I6].Resize(tmp), Type:=xlFillDays For i = 6 To sh.Cells(Rows.Count, "A").End(xlUp).Row ColDates = Range("A" & i).Value DayName = Format(ColDates, "dddd") With Union(sh.Range("B" & i), sh.Range("J" & i)) .Value = DayName End With Next i End With Application.ScreenUpdating = True End Sub Sub PrintTb2() Dim lr As Long Set WS = Sheets("ELRASHIDY") With WS .ResetAllPageBreaks lr = .Cells(.Rows.Count, "a").End(xlUp).Row Application.PrintCommunication = False With WS.PageSetup .PrintArea = WS.Range("A2:O" & lr).Address .FitToPagesWide = 1 .FitToPagesTall = 1 End With Application.PrintCommunication = True WS.PrintPreview 'WS.PrintOut Copies:=1 End With End Sub SHADY TIME TABLE 1_V4.xls 50.5 kB · 4 downloads جزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
AbuuAhmed قام بنشر أغسطس 16 مشاركة قام بنشر أغسطس 16 (معدل) هذا الموضوع به مخالفة لقوانين المنتدى ابتدأ بطلب توزيع أيام الشهر وتم حلها من أول إجابة. ثم تم طلب حل مشكلة طباعة لم تذكر في الطلب منذ البداية أي بمثابة سؤال جديد منفصل. فالمفاضلة التي تمت ليس لها علاقة بالسؤال والخطأ هنا مشترك من السائل ومن زميلي ومن الإشراف الذي لم يتدخل. تم تعديل أغسطس 16 بواسطه AbuuAhmed تعديل خطأ مطبعي رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر أغسطس 17 مشاركة قام بنشر أغسطس 17 في 16/8/2024 at 08:52, AbuuAhmed said: فالمفاضلة التي تمت ليس لها علاقة بالسؤال والخطأ هنا مشترك من السائل ومن زميلي ومن الإشراف الذي لم يتدخل صراحة استاذ أحمد أنا لم أقصد فأنا من أول مشاركة لي أشرت ان الكود الخاص بك في وجهت نظري هو الأفضل ليبقى للسائل إختيار ما يناسبه أما بخصوص الطلب الثاني وهو تنسيق الطباعة قمت بالجواب عنه عند ذكره عدم إختيار أفضل إجابة لأنه بالنسبة له سواء. فقط فهدفنا ليس الحصول او التنافس على نيلها و أعتقد أنك كذلك تشاطرنني نفس الرأي . يرجى من المشرفين نقل الطلب الثاني إلى موضوع مستقل وترك أفضل إجابة للموضوع الأول لأخي وزميلي الأستاذ أحمد بحكم أنه كان سباقا لوجود الحل المناسب .وليكون مرجعا لمن يحتاجه مستقبلا رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان