ابو طيبه

شكرا جزيلا لردك استاذ سليم العزيز سوف اقوم بتجربة الملف غدا لان الان ليس لدي حاسبه مع جزيل الشكر والامتنان لحضرتك

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

الحمد الله تم عمل الكود بنجاح بارك الله بجهودكم

تعديل على الكود لكي يعمل عندما تكون الصفحة محمية الملف والصورة توضح الخطآ وشكرا جزيلا لجهودكم طباعه.xls

شكرا جزيلا استاذ على بارك الله فيك وبجهودك القيمة

السلام عليكم هل يمكن جعل عمود او صفحة من صفحات الاكسل تكون الكتابة بها فقط عربي مع الشكر لجهود الجميع نموذج.xlsx

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

عاشت ايدك استاذ سليم بارك الله بجهودك

بارك الله بيك استاذ شروحات رائعة

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

Sub Print_Selection() ' Dim Cel As Range Dim Rng As Range Dim Del_Rng As Range ScreenOff Return_Sh = ActiveSheet.Name ActiveSheet.Copy after:=Sheets(Sheets.Count) ActiveSheet.UsedRange.Borders.LineStyle = xlNone '=============================================================== Set Rng = Selection Rng.Interior.ColorIndex = 4 Set SourceRange = ActiveSheet.Cells Set destrange = ActiveSheet.Cells SourceRange.Copy destrange.PasteSpecial (xlValues) Application.CutCopyMode = False '=============================================================== For Each Cel In ActiveSheet.UsedRange If Cel.Interior.ColorIndex <> 4 Then If Del_Rng Is Nothing Then Set Del_Rng = Cel Else Set Del_Rng = Application.Union(Del_Rng, Cel) End If End If Next Del_Rng = "" ActiveSheet.UsedRange.Interior.ColorIndex = xlNone '=============================================================== For Each shp In ActiveSheet.Shapes shp.Delete Next shp '=============================================================== ActiveSheet.PrintOut Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True Sheets(Return_Sh).Select '=============================================================== ScreenOn Set Cel = Nothing Set Del_Rng = Nothing ' End Sub السلام عليكم ...خطا في كود طباعه الجزء المحدد وفي كود الترحيل في حال كانت الاوراق محمية.... أرجو من حضراتكم مساعدتى فى حل هذه المشكلة ,بارك الله فيكم جميعا تحياتي للجميع Sub ترحيل() Dim lastRow As Integer, WS As Worksheet, SH As Worksheet Set WS = ThisWorkbook.Worksheets("قائمة"): Set SH = ThisWorkbook.Worksheets("اسماءالمراجعين") lastRow = WS.Cells(Rows.Count, 2).End(xlUp).Row With SH: lr = SH.Cells(Rows.Count, 2).End(xlUp).Row + 1 With .Range("B" & lr): .NumberFormat = "[$-,101]yyyy/mm/dd;@": .Value = Date: .Cells(, 1).Resize(ColumnSize:=4).Merge With .Cells(, 1).Resize(ColumnSize:=4): .Borders.Value = 1: .Borders.Weight = xlMedium: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter: .Font.Bold = True: .Font.ColorIndex = xlAutomatic: .Interior.ThemeColor = xlThemeColorDark1: .Interior.TintAndShade = -0.349986266670736: End With: End With End With WS.Range("b2:e" & lastRow).Copy SH.Range("b" & lr + 1).PasteSpecial Paste:=xlPasteValues WS.Range("b2:b" & Rows.Count).ClearContents MsgBox "لقد تم ترحيل البيانات بنجاح" End Sub ترحيل وطباعة المحدد.xls

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

شكرا جزيلا استاذ وبارك الله بيك الله يكثر من امثالك الله يحفظ احبابك ويرحم امواتك

شكرا جزيلا استاذ حسين الان الكود يعمل ١٠٠% بارك الله بيك على جهودك ومساعدتك الأعضاء في هذا المنتدى الجميل. هل يمكن جعل الباسورد يكون بشكل نجوم وليس ارقام تحياتي لك وجعلها الله في ميزان حسناتك

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