تغییر نام شیتهای اکسل بر اساس جدول فهرست

**M_ExceL** · 2018/07/13, 13:18

نوشته اصلی توسط farhad2631

ضمن عرض سلام . من یک فایل اکسلی مربوط به کارت کارگری درست کردم . می خوام بوسیله یک ماکرو ( ماکرو شماره 4 ) نام شیتها رو بر اساس نام خانوادگی افراد طبق جدول فهرست تغییر بدم .
در ماکرو 4 این کار بصورت ناقص انجام میشه اما اگر اسم جدیدی به جدول فهرست اضافه بشه ماکرو از حالت پویایی خارج و غیر فعال میشه . لطفا بفرمایید چطوری میتونم ماکرویی بنویسم که با ثبت کردن نام جدید به لیست ، بطور اتوماتیک شیت رو تغییر نام بده . با تشکر شریعتی

سلام
یک ماژول ایجاد کنید و از کد زیر استفاده کنید :

کد:

Sub test()
lsrow = Application.WorksheetFunction.CountA(Worksheets("Source").Range("i:i")) - 2
For i = 1 To lsrow
Worksheets("Reference").Copy After:=Sheets(Sheets.Count)
Sheets(i + 2).Name = Worksheets("Source").Range("i" & i + 5)
Next i
End Sub

کد فوق شیت ها رو به تعداد اسامی شیت سورس ایجاد میکنه، سپس نام مربوطه را به شیت اختصاص میده.
مشکلی بود در خدمتم.

**farhad2631** · 2018/07/13, 15:01

سلام و سپاس از پاسخگویی شما دوست عزیز .
متاسفانه ماژول ارسالی شما یک مشکل کوچیک داره ؟؟؟
زمانی که یک ردیف جدید به لیست اضافه میشه و میخوام شیت جدیدی واسش ایجاد کنم ، ماژول شما علاوه بر نام ردیف جدید ، چند شیت هم برای نامهای قبلی درست میکنه .
اگر ممکنه خودتون یکبار امتحان بفرمایید .
مجددا بابت لطف شما متشکرم

**M_ExceL** · 2018/07/14, 02:05

نوشته اصلی توسط farhad2631

سلام و سپاس از پاسخگویی شما دوست عزیز .
متاسفانه ماژول ارسالی شما یک مشکل کوچیک داره ؟؟؟
زمانی که یک ردیف جدید به لیست اضافه میشه و میخوام شیت جدیدی واسش ایجاد کنم ، ماژول شما علاوه بر نام ردیف جدید ، چند شیت هم برای نامهای قبلی درست میکنه .
اگر ممکنه خودتون یکبار امتحان بفرمایید .
مجددا بابت لطف شما متشکرم

سلام، خواهش میکنم
کد رو اصلاح کردم، تست بفرمایید :

کد:

Sub test()
Application.ScreenUpdating = False
lsrow = Application.WorksheetFunction.CountA(Worksheets("Source").Range("i:i")) - 2
If Sheets.Count = 2 Then
For i = 1 To lsrow
Worksheets("Reference").Copy After:=Sheets(Sheets.Count)
Sheets(i + 2).Name = Worksheets("Source").Range("i" & i + 5)
Next i
End If
Do While lsrow <> Sheets.Count - 2
Worksheets("Reference").Copy After:=Sheets(Sheets.Count)
Loop
For j = 1 To lsrow
     If Worksheets("Source").Range("i" & j + 5) <> Sheets(j + 2).Name Then
     Sheets(j + 2).Name = Worksheets("Source").Range("i" & j + 5)
     End If
Next j
Application.ScreenUpdating = True
End Sub

**farhad2631** · 2018/07/14, 02:40

درود و سپاس مجدد .
واقعا متشکرم از اینکه برای من وقت گذاشتید و زحمت پاسخگویی به این سوال رو کشیدید . ماژول شما کاملا کارآمد و صحیح اجرا شد . ممنونم
با کمال پر رویی چند سوال داشتم که در صورت امکان لطف بفرمایید منو راهنمایی کنید :
1- در فایل ارسالی من در ماژول شماره یک فرمانی جهت قفل شدن فایلها نوشته شده ( البته با راهنمایی اساتید همین سایت) به شرح ActiveSheet.protect Password:="12345" حالا اگر ممکنه بفرمایید این کد یا مشابه اون رو در کدام سطر ماژول شما قرار بدم تا شیتهای ایجاد شده قفل شوند ؟؟؟
2- آیا می توان همزمان با تغییر نام شیتهای جدید ، هایپر لینک هم کرد ؟؟( یعنی هن نام شیت طبق جدول تغییر کند و شیت ایجاد شده به نام مندرج در جدول لینک شود )
3-اگر فرصت داشتید در مورد نحوه طراحی این ماژول به زبان مبتدی برای من توضیحاتی بنویسید تا شاید کمی به سواد من در این زمینه اضافه شود .
در پایان مجددا از شما سرور گرامی و دوستانتان که در این سایت زحمت میکشید کمال تشکر را دارم .

**M_ExceL** · 2018/07/14, 12:12

نوشته اصلی توسط farhad2631

درود و سپاس مجدد .
واقعا متشکرم از اینکه برای من وقت گذاشتید و زحمت پاسخگویی به این سوال رو کشیدید . ماژول شما کاملا کارآمد و صحیح اجرا شد . ممنونم
با کمال پر رویی چند سوال داشتم که در صورت امکان لطف بفرمایید منو راهنمایی کنید :
1- در فایل ارسالی من در ماژول شماره یک فرمانی جهت قفل شدن فایلها نوشته شده ( البته با راهنمایی اساتید همین سایت) به شرح ActiveSheet.protect Password:="12345" حالا اگر ممکنه بفرمایید این کد یا مشابه اون رو در کدام سطر ماژول شما قرار بدم تا شیتهای ایجاد شده قفل شوند ؟؟؟
2- آیا می توان همزمان با تغییر نام شیتهای جدید ، هایپر لینک هم کرد ؟؟( یعنی هن نام شیت طبق جدول تغییر کند و شیت ایجاد شده به نام مندرج در جدول لینک شود )
3-اگر فرصت داشتید در مورد نحوه طراحی این ماژول به زبان مبتدی برای من توضیحاتی بنویسید تا شاید کمی به سواد من در این زمینه اضافه شود .
در پایان مجددا از شما سرور گرامی و دوستانتان که در این سایت زحمت میکشید کمال تشکر را دارم .

سلام
خواهش میکنم، خوشحال هستم که مشکلتون حل شد.
امکان protect و Hyperlinks هم به کد افزوده شد.

کد:

Sub test()
Application.ScreenUpdating = False
lsrow = Application.WorksheetFunction.CountA(Worksheets("Source").Range("i:i")) - 2
If Sheets.Count = 2 Then
For i = 1 To lsrow
Worksheets("Reference").Copy After:=Sheets(Sheets.Count)
Sheets(i + 2).Name = Worksheets("Source").Range("i" & i + 5)
Next i
End If
Do While lsrow <> Sheets.Count - 2
Worksheets("Reference").Copy After:=Sheets(Sheets.Count)
Loop
For j = 1 To lsrow
     If Worksheets("Source").Range("i" & j + 5) <> Sheets(j + 2).Name Then
     Sheets(j + 2).Name = Worksheets("Source").Range("i" & j + 5)
     End If
Next j
If Sheets.Count > 2 Then
For l = 1 To lsrow
Sheets(l + 2).protect Password:="12345"
Sheets(l + 2).Hyperlinks.Add Anchor:=Worksheets("Source").Range("i" & l + 5), Address:="", SubAddress:= _
        Sheets(l + 2).Name & "!A1"
Next l
End If
Application.ScreenUpdating = True
End Sub

در خصوص نحوه کد نویسی، خب باید با دستورات vba آشنا باید، در این خصوص آموزش های زیادی در سطح وب و همچنین داخل سایت موجود هست، می تونید استفاده کنید.
در پناه حق .

**farhad2631** · 2018/07/14, 15:24

سلام و عرض ادب .
من از شما دوست گرامی و همچنین همه کسانی که در تشکیل و ساخت این سایت آموزشی نقشی داشته یا دارند متشکرم .
شما مشکلی بزرگی رو واسه من حل کردید . خیلی خیلی متشکرم .
لطفا بفرمایید کتاب خوب (سطح مبتدی ) برای آموزش Vba چه چیزی پیشنهاد میکنید ؟؟
مجددا از همه اساتید این سایت متشکرم بویژه شما سرور گرامی .