اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

اختصار الكود

amir501

بواسطه amir501
في منتدى الاكسيل Excel

 مشاركة

الردود الموصى بها

amir501

amir501

قام بنشر
قام بنشر

اخواني جزاكم الله كل خير هل يمكن اختصار هذا الكود اي اسماء الصفحات


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

رابط هذا التعليق
شارك
احمدزمان

احمدزمان

قام بنشر
قام بنشر

السلام عليكم و رحمة الله وبركاته

جزاك الله خيرا

جرب التالي

[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]

رابط هذا التعليق
شارك
احمدزمان

احمدزمان

قام بنشر
قام بنشر

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

رابط هذا التعليق
شارك
طارق محمود

طارق محمود

قام بنشر
قام بنشر

السلام عليكم

يمكن إستبدال الجزء الطويل التالي


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

amir501

قام بنشر
  • الكاتب
قام بنشر

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

amir501

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم

يمكن إستبدال الجزء الطويل التالي


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

رابط هذا التعليق
شارك
طارق محمود

طارق محمود

قام بنشر
قام بنشر

السلام عليكم

يتضح من الصورة أنك غيرت أسماء الشيتات (ورقات العمل) مثلا Sheet28

أصبح إسمه كرافتة

لذلك فالأفضل إستبدال السطر

 Sheets("Sheet" & i).Visible = xlSheetVeryHidden
بالسطر 
Sheets( i).Visible = xlSheetVeryHidden

رابط هذا التعليق
شارك
amir501

amir501

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم

يتضح من الصورة أنك غيرت أسماء الشيتات (ورقات العمل) مثلا Sheet28

أصبح إسمه كرافتة

لذلك فالأفضل إستبدال السطر

 Sheets("Sheet" & i).Visible = xlSheetVeryHidden
بالسطر 
Sheets( i).Visible = xlSheetVeryHidden

اخي وصديقي طارق لازالت الرسالة نفسها

رابط هذا التعليق
شارك
amir501

amir501

قام بنشر
  • الكاتب
قام بنشر

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

رابط هذا التعليق
شارك
أبوعبد الله

أبوعبد الله

قام بنشر
قام بنشر

أخي العزيز / عامر

أشكرك على كلماتك الرقيقة .

أرفق ملف مع توضيح ماهي الأوراق التي تريد التطبيق عليها وإن شاء الله يأتيك الحل والكل مستعد .

تحياتي

أبو عبدالله

رابط هذا التعليق
شارك
احمدزمان

احمدزمان

قام بنشر
قام بنشر

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

رابط هذا التعليق
شارك
amir501

amir501

قام بنشر
  • الكاتب
قام بنشر

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept