مشكل من : نحوه حذف كردن شيتهاي اضافي با كد vb

[misammisam]

سلام
اول يه توضيحي بدم كه اين مشكل از كجا ناشي ميشه .
همونطور كه ميدونيد وقتي توي اكسل از ابزار pivot table استفاده ميكنيم ، وقتي ميخوايم ريز يك ايتم رو ببينيم اكسل براي هر گزارش يك sheet تازه ميسازه ، كه عملا وقتي كارت با اين sheet ها تموم ميشه ميتوني پاكشون كني ، حالا مشكل من اينجاست كه وقتي فايل اكسل رو در اختيار همكاراي تازه كار قرار ميدم وقتي ميخوان اين sheet هاي اضافرو پاك كنن ، ميزنن اشتباهي شيتهايي كه بايد ثابت باشن مثل ديتاها رو پاك ميكنن .
اينم بگم كه نميتونم براي جلوگيري از حذف كردن ، شيتها رو قفل كنم چون بايد اطلاعات جديد توش ثبت كنن .

حالا من چيزي ميخوام كه يكي از اين دو كار رو برام انجام بده :

1 : كدي كه بتونه شيتهاي توليد شده جديد ( يعني به غير از شيتهاي ثابتم ) رو حذف كنه .

يــــــــا

2 : وقتي روي pivot table براي گزلرش گيري كليك ميكنم شيتهايي كه توليد ميكنه فقط به يك اسم باشه ( يعني شيت جديد نسازه و روي يك شيت با اسم ثابت كپي بشه )

تشكر از همه

[امين اسماعيلي]

خب برا مشکل شما من اینو در اولین نگاه به ذهنم رسیده شاید بهترین روش نباشه
شما یه سری شیت ثابت داری درسته خوب
بزار این شیت های هی تولید بشن . اشکالی نداره. ت. ایونت خارج شدن از فایل اکسل د ر Workbook ویژوال یه کد میخوای با حلقه For که هر چی شیت غیر از اون اصلی یاست رو پاک و سیو خودکار کنه . همین

[امين اسماعيلي]

با درود
مثلا همچین کدی در ایونت ورک بوک

فرض کن شیت 1 و 2 اصلیا هستن و من تو کد نویسی از نام کدنویسی انها استفاده کردم شاید شما نام رو توی شیت عوض کرده باشی که مهم نیست . ب جز 1 و 2 همه شیت ها بدون الارمی پاک شده و تغییرات خودکار سیو و بسته میشن

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If ws.CodeName <> "Sheet1" And ws.CodeName <> "Sheet2" Then ws.Delete
Next
Application.DisplayAlerts = True
ActiveWindow.Close SaveChanges:=True
End Sub

[misammisam]

با درود
مثلا همچین کدی در ایونت ورک بوک

فرض کن شیت 1 و 2 اصلیا هستن و من تو کد نویسی از نام کدنویسی انها استفاده کردم شاید شما نام رو توی شیت عوض کرده باشی که مهم نیست . ب جز 1 و 2 همه شیت ها بدون الارمی پاک شده و تغییرات خودکار سیو و بسته میشن

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If ws.CodeName <> "Sheet1" And ws.CodeName <> "Sheet2" Then ws.Delete
Next
Application.DisplayAlerts = True
ActiveWindow.Close SaveChanges:=True
End Sub

امين جان دستت درد نكنه خيلي خوب بود