amir501 قام بنشر أغسطس 3, 2010 قام بنشر أغسطس 3, 2010 اخواني جزاكم الله كل خير هل يمكن اختصار هذا الكود اي اسماء الصفحات Sub auto_open() Dim Expiry As Date Expiry = DateValue("30/7/2010") If Date > Expiry Then Dim CEL As Range Application.ScreenUpdating = False Application.Calculation = xlManual For S = 1 To ActiveWorkbook.Sheets.Count Sheets(S).Activate For Each CEL In ActiveSheet.UsedRange If CEL.HasFormula = True Then CEL = CEL.Value Next CEL Next S End If Application.Calculation = xlAutomatic Application.ScreenUpdating = False sheet2.Visible = xlSheetVeryHidden sheet3.Visible = xlSheetVeryHidden sheet4.Visible = xlSheetVeryHidden sheet5.Visible = xlSheetVeryHidden sheet6.Visible = xlSheetVeryHidden sheet7.Visible = xlSheetVeryHidden sheet8.Visible = xlSheetVeryHidden sheet9.Visible = xlSheetVeryHidden sheet10.Visible = xlSheetVeryHidden sheet11.Visible = xlSheetVeryHidden sheet12.Visible = xlSheetVeryHidden sheet13.Visible = xlSheetVeryHidden sheet14.Visible = xlSheetVeryHidden sheet16.Visible = xlSheetVeryHidden sheet16.Visible = xlSheetVeryHidden sheet17.Visible = xlSheetVeryHidden sheet18.Visible = xlSheetVeryHidden sheet19.Visible = xlSheetVeryHidden sheet20.Visible = xlSheetVeryHidden sheet21.Visible = xlSheetVeryHidden sheet22.Visible = xlSheetVeryHidden sheet23.Visible = xlSheetVeryHidden sheet24.Visible = xlSheetVeryHidden sheet25.Visible = xlSheetVeryHidden sheet26.Visible = xlSheetVeryHidden sheet27.Visible = xlSheetVeryHidden sheet28.Visible = xlSheetVeryHidden sheet29.Visible = xlSheetVeryHidden sheet30.Visible = xlSheetVeryHidden sheet31.Visible = xlSheetVeryHidden sheet32.Visible = xlSheetVeryHidden sheet33.Visible = xlSheetVeryHidden sheet34.Visible = xlSheetVeryHidden sheet35.Visible = xlSheetVeryHidden sheet36.Visible = xlSheetVeryHidden sheet37.Visible = xlSheetVeryHidden sheet38.Visible = xlSheetVeryHidden sheet39.Visible = xlSheetVeryHidden sheet40.Visible = xlSheetVeryHidden sheet41.Visible = xlSheetVeryHidden sheet1.Visible = True sheet1.Select ActiveWorkbook.Save ActiveWorkbook.Close End Sub
احمدزمان قام بنشر أغسطس 3, 2010 قام بنشر أغسطس 3, 2010 السلام عليكم و رحمة الله وبركاته جزاك الله خيرا جرب التالي [size="2"][color="#660066"]Sub[/color] auto_open[color="#666600"]()[/color] [/size][size="2"][color="#660066"]Dim[/color] [color="#660066"]Expiry[/color] [color="#660066"]As[/color] [color="#660066"]Date[/color] [/size][size="2"] [color="#660066"]Expiry[/color] [color="#666600"]=[/color] [color="#660066"]DateValue[/color][color="#666600"]([/color][color="#008800"]"30/7/2010"[/color][color="#666600"])[/color] [/size][size="2"] [color="#660066"]If[/color] [color="#660066"]Date[/color] [color="#666600"]>[/color] [color="#660066"]Expiry[/color] [color="#660066"]Then[/color] [/size][size="2"][color="#660066"]Dim[/color] CEL [color="#660066"]As[/color] [color="#660066"]Range[/color] [/size][size="2"] [color="#660066"]Application[/color][color="#666600"].[/color][color="#660066"]ScreenUpdating[/color] [color="#666600"]=[/color] [color="#000088"]False[/color] [/size][size="2"][color="#660066"]Application[/color][color="#666600"].[/color][color="#660066"]Calculation[/color] [color="#666600"]=[/color] xlManual [/size][size="2"][color="#660066"]For[/color] S [color="#666600"]=[/color] [color="#006666"]1[/color] [color="#660066"]To[/color] [color="#660066"]ActiveWorkbook[/color][color="#666600"].[/color][color="#660066"]Sheets[/color][color="#666600"].[/color][color="#660066"]Count[/color] [/size][size="2"][color="#660066"]Sheets[/color][color="#666600"]([/color]S[color="#666600"]).[/color][color="#660066"]Activate[/color] [/size][size="2"][color="#660066"]For[/color] [color="#660066"]Each[/color] CEL [color="#660066"]In[/color] [color="#660066"]ActiveSheet[/color][color="#666600"].[/color][color="#660066"]UsedRange[/color] [/size][size="2"][color="#660066"]If[/color] CEL[color="#666600"].[/color][color="#660066"]HasFormula[/color] [color="#666600"]=[/color] [color="#000088"]True[/color] [color="#660066"]Then[/color] CEL [color="#666600"]=[/color] CEL[color="#666600"].[/color][color="#660066"]Value[/color] [/size][size="2"][color="#660066"]Next[/color] CEL [/size][size="2"][color="#660066"]IF S <> 1 THEN SHEETS(S)[/color][color="#666600"] .[/color][color="#660066"]Visible[/color] [color="#666600"]=[/color] xlSheetVeryHidden [/size][size="2"][color="#660066"]Next[/color] S [/size][size="2"][color="#660066"]End[/color] [color="#660066"]If[/color] [/size][size="2"][color="#660066"]Application[/color][color="#666600"].[/color][color="#660066"]Calculation[/color] [color="#666600"]=[/color] xlAutomatic [/size][size="2"][color="#660066"]Application[/color][color="#666600"].[/color][color="#660066"]ScreenUpdating[/color] [color="#666600"]=[/color] [color="#000088"]False[/color] [/size][size="2"]sheet1[color="#666600"].[/color][color="#660066"]Visible[/color] [color="#666600"]=[/color] [color="#000088"]True[/color] [/size][size="2"]sheet1[color="#666600"].[/color][color="#660066"]Select[/color] [/size][size="2"][color="#660066"]ActiveWorkbook[/color][color="#666600"].[/color][color="#660066"]Save[/color] [/size][size="2"][color="#660066"]ActiveWorkbook[/color][color="#666600"].[/color][color="#660066"]Close[/color] [/size][size="2"][color="#660066"]End[/color] [color="#660066"]Sub[/color][/size]
احمدزمان قام بنشر أغسطس 3, 2010 قام بنشر أغسطس 3, 2010 Sub auto_open() Dim Expiry As Date Expiry = DateValue("30/7/2010") If Date > Expiry Then Dim CEL As Range Application.ScreenUpdating = False Application.Calculation = xlManual For S = 1 To ActiveWorkbook.Sheets.Count Sheets(S).Activate For Each CEL In ActiveSheet.UsedRange If CEL.HasFormula = True Then CEL = CEL.Value Next CEL IF S <> 1 THEN SHEETS(S) .Visible = xlSheetVeryHidden Next S End If Application.Calculation = xlAutomatic Application.ScreenUpdating = False sheet1.Visible = True sheet1.Select ActiveWorkbook.Save ActiveWorkbook.Close End Sub
طارق محمود قام بنشر أغسطس 3, 2010 قام بنشر أغسطس 3, 2010 السلام عليكم يمكن إستبدال الجزء الطويل التالي Sheet2.Visible = xlSheetVeryHidden Sheet3.Visible = xlSheetVeryHidden sheet4.Visible = xlSheetVeryHidden sheet5.Visible = xlSheetVeryHidden sheet6.Visible = xlSheetVeryHidden sheet7.Visible = xlSheetVeryHidden sheet8.Visible = xlSheetVeryHidden sheet9.Visible = xlSheetVeryHidden sheet10.Visible = xlSheetVeryHidden sheet11.Visible = xlSheetVeryHidden sheet12.Visible = xlSheetVeryHidden sheet13.Visible = xlSheetVeryHidden sheet14.Visible = xlSheetVeryHidden sheet16.Visible = xlSheetVeryHidden sheet16.Visible = xlSheetVeryHidden sheet17.Visible = xlSheetVeryHidden sheet18.Visible = xlSheetVeryHidden sheet19.Visible = xlSheetVeryHidden sheet20.Visible = xlSheetVeryHidden sheet21.Visible = xlSheetVeryHidden sheet22.Visible = xlSheetVeryHidden sheet23.Visible = xlSheetVeryHidden sheet24.Visible = xlSheetVeryHidden sheet25.Visible = xlSheetVeryHidden sheet26.Visible = xlSheetVeryHidden sheet27.Visible = xlSheetVeryHidden sheet28.Visible = xlSheetVeryHidden sheet29.Visible = xlSheetVeryHidden sheet30.Visible = xlSheetVeryHidden sheet31.Visible = xlSheetVeryHidden sheet32.Visible = xlSheetVeryHidden sheet33.Visible = xlSheetVeryHidden sheet34.Visible = xlSheetVeryHidden sheet35.Visible = xlSheetVeryHidden sheet36.Visible = xlSheetVeryHidden sheet37.Visible = xlSheetVeryHidden sheet38.Visible = xlSheetVeryHidden sheet39.Visible = xlSheetVeryHidden sheet40.Visible = xlSheetVeryHidden sheet41.Visible = xlSheetVeryHidden بــــالتالي For i = 2 To 41 Sheets("Sheet" & i).Visible = xlSheetVeryHidden Next i
amir501 قام بنشر أغسطس 3, 2010 الكاتب قام بنشر أغسطس 3, 2010 Sub auto_open() Dim Expiry As Date Expiry = DateValue("30/7/2010") If Date > Expiry Then Dim CEL As Range Application.ScreenUpdating = False Application.Calculation = xlManual For S = 1 To ActiveWorkbook.Sheets.Count Sheets(S).Activate For Each CEL In ActiveSheet.UsedRange If CEL.HasFormula = True Then CEL = CEL.Value Next CEL IF S <> 1 THEN SHEETS(S) .Visible = xlSheetVeryHidden Next S End If Application.Calculation = xlAutomatic Application.ScreenUpdating = False sheet1.Visible = True sheet1.Select ActiveWorkbook.Save ActiveWorkbook.Close End Sub اخي احمد اشكرك لسرعة الاجابة هل تتكرم وترى الصورة المرفقة مبينة فيها رسالة الخطا التي ظهرت لي ....واكرر شكري وامتناني Presentation1.rar
amir501 قام بنشر أغسطس 3, 2010 الكاتب قام بنشر أغسطس 3, 2010 السلام عليكم يمكن إستبدال الجزء الطويل التالي Sheet2.Visible = xlSheetVeryHidden Sheet3.Visible = xlSheetVeryHidden sheet4.Visible = xlSheetVeryHidden sheet5.Visible = xlSheetVeryHidden sheet6.Visible = xlSheetVeryHidden sheet7.Visible = xlSheetVeryHidden sheet8.Visible = xlSheetVeryHidden sheet9.Visible = xlSheetVeryHidden sheet10.Visible = xlSheetVeryHidden sheet11.Visible = xlSheetVeryHidden sheet12.Visible = xlSheetVeryHidden sheet13.Visible = xlSheetVeryHidden sheet14.Visible = xlSheetVeryHidden sheet16.Visible = xlSheetVeryHidden sheet16.Visible = xlSheetVeryHidden sheet17.Visible = xlSheetVeryHidden sheet18.Visible = xlSheetVeryHidden sheet19.Visible = xlSheetVeryHidden sheet20.Visible = xlSheetVeryHidden sheet21.Visible = xlSheetVeryHidden sheet22.Visible = xlSheetVeryHidden sheet23.Visible = xlSheetVeryHidden sheet24.Visible = xlSheetVeryHidden sheet25.Visible = xlSheetVeryHidden sheet26.Visible = xlSheetVeryHidden sheet27.Visible = xlSheetVeryHidden sheet28.Visible = xlSheetVeryHidden sheet29.Visible = xlSheetVeryHidden sheet30.Visible = xlSheetVeryHidden sheet31.Visible = xlSheetVeryHidden sheet32.Visible = xlSheetVeryHidden sheet33.Visible = xlSheetVeryHidden sheet34.Visible = xlSheetVeryHidden sheet35.Visible = xlSheetVeryHidden sheet36.Visible = xlSheetVeryHidden sheet37.Visible = xlSheetVeryHidden sheet38.Visible = xlSheetVeryHidden sheet39.Visible = xlSheetVeryHidden sheet40.Visible = xlSheetVeryHidden sheet41.Visible = xlSheetVeryHidden بــــالتالي For i = 2 To 41 Sheets("Sheet" & i).Visible = xlSheetVeryHidden Next i اخي طارق اشكرك لسرعة الاجابة هل تتكرم وترى الصورة المرفقة مبينة فيها رسالة الخطا التي ظهرت لي ....واكرر شكري وامتناني 222.rar
طارق محمود قام بنشر أغسطس 3, 2010 قام بنشر أغسطس 3, 2010 السلام عليكم يتضح من الصورة أنك غيرت أسماء الشيتات (ورقات العمل) مثلا Sheet28 أصبح إسمه كرافتة لذلك فالأفضل إستبدال السطر Sheets("Sheet" & i).Visible = xlSheetVeryHidden بالسطر Sheets( i).Visible = xlSheetVeryHidden
amir501 قام بنشر أغسطس 3, 2010 الكاتب قام بنشر أغسطس 3, 2010 السلام عليكم يتضح من الصورة أنك غيرت أسماء الشيتات (ورقات العمل) مثلا Sheet28 أصبح إسمه كرافتة لذلك فالأفضل إستبدال السطر Sheets("Sheet" & i).Visible = xlSheetVeryHidden بالسطر Sheets( i).Visible = xlSheetVeryHidden اخي وصديقي طارق لازالت الرسالة نفسها
أبوعبد الله قام بنشر أغسطس 3, 2010 قام بنشر أغسطس 3, 2010 أخي العزيز / عامر بتعديل بسيط على كود أخي العزيز أحمد يعقوب والشكر موصول له تم عمل اللازم بالمرفق . تحياتي أبو عبدالله تحويل المعادلات لقيم.rar
amir501 قام بنشر أغسطس 3, 2010 الكاتب قام بنشر أغسطس 3, 2010 مشكور يا اخي ابو عبد الله دايما كاخوانك سباق الى عمل الخير جعله الله في رصيد حسناتك... عندي سؤال صغير وهو اني اريد تطبيق الكود على عدة صفحات من اصل 42 صفحة ماذا افعل...وجزاك الله كل خير
أبوعبد الله قام بنشر أغسطس 3, 2010 قام بنشر أغسطس 3, 2010 أخي العزيز / عامر أشكرك على كلماتك الرقيقة . أرفق ملف مع توضيح ماهي الأوراق التي تريد التطبيق عليها وإن شاء الله يأتيك الحل والكل مستعد . تحياتي أبو عبدالله
احمدزمان قام بنشر أغسطس 4, 2010 قام بنشر أغسطس 4, 2010 السلام عليكم و رحمة اللهاستاذنا الحبيب المهندس طارقجزاك الله كل خيراستاذنا الحبيب ابو عبداللهجزاك الله كل خيركلاكما ابدع بارك الله فيكم
amir501 قام بنشر أغسطس 4, 2010 الكاتب قام بنشر أغسطس 4, 2010 اخواني المهندس طارق واخونا الحبيب ابو عبدالله اشكركما من كل قلبي للمساعدة كما قال اخي احمد كلاكما ابدع في هذا الكود اللهم اجعل لهما في كل حرف حسنة وفي كل خطوة حسنة ...واهنكما بدوري بقدوم رمضان جعله الله شهرا مباركا لكم ولعائلاتكم ولاخواننا في هذا المنتدى الغالي والقائمين عليه...جزاكم الله كل خير
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.