نجوم المشاركات

جرب هذا الملف الكود Sub Show_hide_col() Application.ScreenUpdating = False Dim my_rg As Range Dim i%, x% Dim t As Byte t = IIf([b1] = "اداري", 1, 2) Set my_rg = Range("E1:AT1") my_rg.Columns.Hidden = False x = my_rg.Columns.Count For i = 1 To x If my_rg.Cells(i) <> t Then my_rg.Cells(i).EntireColumn.Hidden = True End If Next Application.ScreenUpdating = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$B$1" Then Show_hide_col End If Application.EnableEvents = True End Sub الملف مرفق مرتبات.xlsm

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

استبدل الكود الى هذا Option Explicit Sub Show_hide_col() Application.ScreenUpdating = False Dim my_rg As Range Dim i% Dim t As Byte t = IIf([b1] = "اداري", 1, 2) Set my_rg = Range("E1:AT1") my_rg.Columns.Hidden = True For i = 1 To my_rg.Columns.Count With my_rg.Cells(i) If .Value = t Or _ .Value = vbNullString Then _ .EntireColumn.Hidden = False End With Next Application.ScreenUpdating = True End Sub Rem================================= Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$B$1" Then Show_hide_col End If Application.EnableEvents = True End Sub الملف معدل _salimمرتبات.xlsm

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

ربما كان عندك نظام التاريخ بتنسيق اميركي شهر /يوم/ سنة mm/dd/yyyy لذلك يجب اما ان تغير نظام التاريخ الى انكليزي dd/mm/yyyyy او ان تكتب تاريخ البداية والنهاية(والتواريخ في الصف الثّاني) بكتابة الشهر أولاً ثم اليوم ثم السنة مثلاً 25/1/2019 تكتب هكذا 1/25/2019

يمكنك استخدام هذه المعادلة وهى معادلة مصفوفة اى لابد من الضغط بعد كتابة المعادلة على Ctrl+Shift+Enter وليس Enter فقط كباقى المعادلات =B2-A2+1-SUMPRODUCT(IF(WEEKDAY(ROW(INDIRECT(A2&":"&B2)))={7,3},1,0))

استاذنا لا تكلف حالك...انحلت المشكلة بس نزلت الكود الخاص باليوم وضعته اخر شي بالكودات...ربي يحفظكم ويكثر من امثالكم

شكراً لكم من أعماق قلبي على عطائكم الدائم جزاكم الله كــــل خيراً

شكراً لك لقد أعدت تنزيل الملف مرة ثانية و لم يعمل و ظهرت شاشة رمادية بدل جدول إكسل. و حل المشكلة كان ترتيب أيام الأسبوع و لم أعرف ما ضرورة ذلك لأن الدالة تعمل بصورة سليمة إذا كانت المحتويات بين القوسين المتعرجين غير أسماء الأسبوع لست مٓن دعاها مصفوفة Array هذا ما جاء في هذا الرابط: https://answers.microsoft.com/en-us/msoffice/forum/all/curly-brackets-commas-and-semicolons-what-to-use/d6268be4-8f54-4288-885d-1d1a0d9510a8 و لك كل الشكر فلطالما استفدت من مشاركاتك. و طبقاً للرابط المصفوفة ضمن القوسين المتعرجين و هو ما ذكرته في نص السؤال و لم أتطرق إلى أن المعادلة معادلة صفيف أم لا . If the whole formula is surrounded by curly brackets, you have an array formula, that is correct, but this is different. Curly brackets inside a formula are also an array, one or two dimensional.

الملف ليس معطوب ولكن تفضل هذه هى المعادلة وليست مصفوفة -ضعها فى الخلية J2 واسحب للإسفل =IF(C2="","",VLOOKUP(TEXT(C2,"DDDD"),{"Sunday","الأحد";"Monday","الإثنين";"Tuesday","الثلاثاء";"Wednesday","الأربعاء";"Thursday","الخميس";"Friday","الجمعة";"Saturday","السّبت"},2,0))

بمجرد تغيير حجم الصفحة تظهر الرسالة السابقة. تم حل المشكلة، قمت بتحديد الملف كاملاً، واتبعت الخطوات السابقة بالضغط على "أعمدة" واخترت "واحد"، وأصبحت الأمور على ما يرام. أشكر لك أستاذ برقش مجهوداتك الطيبة معنا. والشكر موصول لكل من شارك معنا. دمتم بخير

المشكلة لديك اخى الكريم فكما ترى الملف يعمل بكل كفاءة

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

حاولت التعديل في الكود بحيث يقتصر إخفاء الأعمدة على دلالة الأرقام بالصف الأول واستثناء الأعمدة ذات الخلايا البينية الفارغة ولكني فشلت

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

وعليكم السلام - تفضل WeekDay.xlsx

اشكرك وزادك الله من علمه

تفضل الفرق بين تاريخين2018.xlsm

السلام عليكم اختنا الكريمة .. تأكدي ان غالب من في هذا المنتدى يبذلون المساعدة مجانا لوجه الله .. ويقتطعون جزأ من اوقاتهم لذلك وتأكدي لو عند احدهم المعلومة ويقدر على مساعدتك لن يتوانى في ذلك فأنت عملت السبب وعليك الانتظار والصبر ويكفي للتذكير تكتبين كلمة : للرفع من اجل صعود الموضوع في بداية الصفحة ولست بحاجة الى اعادة كتابة الموضوع من جديد اعانك الله ووفقك

السلام عليكم أستاذ المشكل هو : عندما أغير تاريخ البداية والنهاية الجدول يختفي ويخرج مربع الحوار هذا

تفضل جرب المرفق أخى احمد محمد ماترك ok_ماترك.xlsm

حدد من فضلك المشكلة التى تظهر معك بالضبط فأنا لا أجد اى مشكلة فى الملف وهو يعمل بكل كفاءة وذلك كما ترى بالصورة

تفضل hالكهرباء.xls

تفضل ما طلبت كود عند الضغط يذهب الى الصفحة.xlsm

جرب هذا الملف من ملغاتي القديمة wprking_days_Vba.xlsm

اجعل نوع الخط Wingdings 2

تسلم ياعسل 🌹 هل بالإمكان عند عمل فرز لتقرير ان يتم حفظه بيانات الفرز كتقرير جديد داخل الاكسس وتشكرا

هذا الكود يسمح لك بتحديد الخلية المحمية فقط دون ان يسمح بأي اجراء عليها(حذف--- تعديل---نسخ ---الخ) و يخفي المعادلة ايضاً و لا يأخذ بالحسبان الا المعادلات ( جربه و اعطني رأيك) Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Unprotect If Target.HasFormula Then With Target .Locked = True .FormulaHidden = True End With With ActiveSheet .Protect .EnableSelection = xllockedCells End With End If End Sub

انسخ هذا الكود الى حدث الصفحة و اعطني رأيك Private Sub Worksheet_SelectionChange(ByVal Target As Range) '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Application.ScreenUpdating = False If Target.HasFormula = True Then Application.DisplayFormulaBar = False ActiveSheet.Protect Application.ScreenUpdating = True Exit Sub Else Application.DisplayFormulaBar = True ActiveSheet.Unprotect End If Application.ScreenUpdating = True End Sub

اذن اخي من الاحسن ان تستعمل هذ الكود الذي طرحته في مشاركة سابقة Private Sub Worksheet_Selectionchange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select ElseIf Target.MergeCells = True And Target.HasFormula = True Then Target.Offset(0, 1).Select ElseIf ActiveCell.HasFormula = True And ActiveCell.MergeCells = True Then ActiveCell.Offset(0, 1).Select End If End Sub

أخى الفاضل / عباس السماوى بعد التحية عذرا لهذا السهو برجاء استبدال السطر التالى For I = Range("E1") To Range("F1") بالسطر التالى For I = Range("E1") To Range("F1") Step 2 وكل عام وأنتم بخير

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصيام والقيام وصالح الأعمال... أخي الكريم وأستسمح أخي العزيز رجب لأقوم بتغيير طفيف على كوده حسب المطلوب الجديد... في الكود الخاص بطباعة المحدد عليك تغيير السطر For I = Range("E1") To Range("F1") بالسطر For I = Range("E1") To Range("F1") Step 2 والله أعلم

السلام عليكم الاستاذ العزيز رجب دام عزكم وحفظكم الله ورعاكم جزاك الله خيرا واكواد اكثر من رائعة جعلها الله سبحانه وتعالى في ميزان حسناتكم وتقبل الله منكم قيامكم وصيامكم في الشهر الفضيل رمضان المبارك استاذي الفاضل توجد مشكلة فقط في كود (الطبع المحدد) وهي في حال طلب عدد مثلا اربعة شهادات من 25 الى 28 فالمفروض يطبع شهادتين مع بعض 25 و26 في ورقة واحدة و27و 28 في ورقة واحدة اخرى لكن الكود يقوم بتكرار الشهادة الثانية من كل ورقة يعني يطبع اربعة اوراق 25و26 في ورقة واحدة و26و27 في اخرى و27و28 في اخرى وفي الورقة الرابعة يطبع 28و29 اخي العزيز جميعنا ان شاء الله صيام ارجو عدم الاستعجال في الرد خوفا على سلب راحتك فارجو ان يكون الحل على حسب فراغك وراحتك وتقبل الله منكم ومنا صالح الاعمال ودمتم برعاية الله وحفظه

تم عمل المطلوب الشهادات 2.rar

أخى الفاضل / عباس السماوى كل عام وأنتم بخير هذه هى الأكواد الخاصة بالفصل A أرجو التجربة وان كانت تمام يتم تطبيقها على باقى الفصول Sub طبع_محدد() Dim I As Integer For I = Range("E1") To Range("F1") Range("J1") = I If I <= Range("K1") Then ActiveSheet.PageSetup.PrintArea = "$B$2:$P$30" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If Next I Range("E1").Select End Sub Sub طباعة_ورقة_واحدة() ActiveSheet.PageSetup.PrintArea = "$B$2:$P$30" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End Sub Sub طباعة_الكل() Range("J1").Select ActiveCell.FormulaR1C1 = "1" ActiveSheet.PageSetup.PrintArea = "$B$2:$P$30" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Do ActiveCell = ActiveCell + 2 ActiveWindow.SelectedSheets.PrintOut Loop Until ActiveCell.Value >= Range("C1").Value Range("E1").Select End Sub وبالنسبة لنطاق الطباعة يتم تحديده فى السطر التالى ActiveSheet.PageSetup.PrintArea = "$B$2:$P$30" وهو طبعا سوف يتغير من فصل لآخر مع بعض التغيرات فى الأكود حسب نطاق وخلايا بيانات كل فصل الشهادات.rar