دستور اضافه شدن یک شیت خاص با اضافه شدن یک سطر [بایگانی]

ali65e

2013/12/19, 08:44

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

Amir Ghasemiyan

2013/12/19, 09:15

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

با عرض سلام مجدد خدمت دوست عزيز

شما بايد از vba استفاده كنيد.

يك نمونه ساده خدمت شما. شخصي سازيش با خودتون :)

Sub sheetnaming()
Name = Range("A1").Value
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Name
End Sub

ali65e

2013/12/19, 09:47

سلام مجدد خدمت دوست عزیزم
امیر جان تابعی که زحمت کشیده بودی برای سلول a1 کاملا درست عمل می کنه ولی برای سایر آیتمهای ستون a عمل نداره. برای مثلا سلول a2 چه تغیراتی باید توو مارکو بدم؟فایلشو پیوست می کنم خدمتتون .اگه امکان داره روو همین فایل اصلاح کنید برام بفرستید.متشکرم

Amir Ghasemiyan

2013/12/19, 10:08

سلام مجدد خدمت دوست عزیزم
امیر جان تابعی که زحمت کشیده بودی برای سلول a1 کاملا درست عمل می کنه ولی برای سایر آیتمهای ستون a عمل نداره. برای مثلا سلول a2 چه تغیراتی باید توو مارکو بدم؟فایلشو پیوست می کنم خدمتتون .اگه امکان داره روو همین فایل اصلاح کنید برام بفرستید.متشکرم

من دقيق متوجه منظورتون نشدم. ولي فكر كنم همچين چيزي مد نظرتون باشه.
شما در سلول B1 مقداري رو وارد ميكنيد كه در واقع نشان دهنده شماره سطر خواهد بود. مثلا اگه بخواهيد سلول A4 رو به عنوان نام استفاده كنيد بايد سلول B1 رو برابر 4 قرار بدين

Sub sheetnaming()
C = Range("B1").Value
Name = Range("A" & C).Value
Range("B1").Value = C + 1
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Name
End Sub

ali65e

2013/12/19, 12:25

سلام مجدد
امیر جان گویا منظورمو خوب نتونستم برسونم.امیر جان واسه اینکه منظورمو بهتر برسونم دو تا فایل ضمیمه می کنم که توضیحات لازمو تووش دادم.ممنون

Amir Ghasemiyan

2013/12/19, 13:01

سلام مجدد
امیر جان گویا منظورمو خوب نتونستم برسونم.امیر جان واسه اینکه منظورمو بهتر برسونم دو تا فایل ضمیمه می کنم که توضیحات لازمو تووش دادم.ممنون

سلام دوست عزيز
خب الان كامل متوجه شدم

شما در سلول B1 اين فرمول رو بنويسيد

=COUNTIF(A:A;"*")-1

در vba هم اين دستورات رو قرار بدين

Sub sheetnaming()
c = Range("B1").Value
For e = 2 To c
Sheets("Sheet2").Select
Name = Range("A" & e).Value
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Name
Next e
End Sub

ali65e

2013/12/19, 14:03

داداش گل دستت درد نکنه.خیلی عالی بود:rolleyes:

ali65e

2013/12/23, 10:19

امیر جان چگونه میشه تغییراتی توو این ماکرو بدیم که ماکرو،نام شیت را ، در سلول a1 همان شیتی که ایجاد کرده است بنویسد؟

khakzad

2013/12/23, 10:47

با اجازه جناب قاسمیان
دوست عزیز.اون خط کد آخر میاد اسم یک سلول از شیت اول رو به عنوان نام شیت در نظر می گیره.
شما یک خط کد مشابه همین اضافه کنید ولی بجای اینکه activesheet.name رو مساوی متغیر name بذارید. activesheet.range("a1")i رو مساوی متغیر مورد نظر قرار بدید.
سوالی بود در خدمتم

ali65e

2013/12/23, 11:05

سلام دوست عزیز
خانم خاکزاد این تغییری که شما زحمت کشیده بودید گفتید،تقریبا درست عمل می کنه ولی مشکلی که داره اینه نام شیت هایی که ایجاد می شوند دیگر برابر با نام دانش آموزان نمی شود .
متن ماکرویی که اعمال شده این است
Sub sheetnaming()
Sheets("Sheet2").Select
c = Range("I11").Value
For e = 2 To c + 1
Name = Range("G" & e).Value
Sheets("Sheet20").Select
Sheets("Sheet20").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Range("a1") = Name
Sheets("Sheet2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Range("G" & e), Address:="", SubAddress:=Name & "!A1", TextToDisplay:=Name

Range("G2:G40").Select
With Selection.Font
.Name = "B Nazanin"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
Next e
End Sub

khakzad

2013/12/23, 11:25

کد قبلی رو حذف نکینید
اینو زیرش اضافه کنید
شما activesheet.name رو حذف کردید!

ali65e

2013/12/23, 12:00

ممنون خانم خاکزاد.کاملا درست بود.:)فقط خانم خاکزاد می بخشید چطوری میشه کاری کرد که متنی که همین ماکرو در سلول a1 می نویسد بافونت خاصی "b nazanin 13.5"باشد؟

khakzad

2013/12/23, 12:55

خودتون که کدشو در ادامه گذاشتین

Range("G2:G40").Select
With Selection.Font
.Name = "B Nazanin"

حالا رنج رو همون a1 بذارید.البته این قسمتی از کدتون هست.خواستم یادآوری کنم که خودتون بلدید :)

ali65e

2013/12/23, 13:14

خانم خاکزاد این قسمتی که در ادامه تابع من اومده فقط داده های g2 تا g40 شیت 2 رو تغییر فونت میده .من می خواهم تمام سلول های a2 ای که ماکرو در شیت هایی که قبلا ایجاد کرده، تغییر فونت بده.

khakzad

2013/12/23, 14:09

خب همینه!
مشابه این کد رو داخل حلقه for که قبلا نوشتید، بعد از اون خط کدی که اضافه می کنید بنویسید.activesheet.range("a1")i رو select کنید.بقیش مشابه کد خودتون
(هدف این هست که شما مسلط بشید به کدها و . . . برای همین مستقیم نمی نویسم.سعی می کنم راهنمایی کنم :o)
موفق باشید

ali65e

2013/12/23, 16:39

سلام مجدد خدمت دوستان خوبم
دوستان تا این جا خداروشکر به لطف کمک های شما دوستان عزیز جلو رفتم ولی متاسفانه نمی دانم چرا این مشکلات تمامی نداره و هر چی جلوتر میرم با مشکلات جدیدتری مواجه میشم که باز منو مجبور می کنه علارقم میل باطنیم مزاحم شما ببشم.
دوستان تا این جا تونستیم با کمک دوستان ماکرویی بسازیم که شیت هایی هم نام با داده های یکی از ستون ها(ستون نام ونام خانوادگی دانش آموز) بسازیم .دوستان مشکلی که در حال حاضر با آن مواجه شدم اینه که می خوام داده های یک سلول خاص که حاوی معدل دانش آموز است را با معدل دیگر دانش آموزان که در سلول مشابه همین سلول در دیگر شیت های قرار دارد را، مقایسه کنم و در انتها رتبه دانش آموز در یکی از سلول های هر شیت درج بشه.
دوستان متن ماکرویی که شیت ها رو می سازه رو خدمتتون میذارم که تونسته باشم بهتر منظورمو برسونم
Sub sheetnaming()
Sheets("Sheet2").Select
c = Range("I11").Value
For e = 2 To c + 1
Name = Range("G" & e).Value
Sheets("Sheet20").Select
Sheets("Sheet20").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Name
ActiveSheet.Range("a1") = Name
Sheets("Sheet2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Range("G" & e), Address:="", SubAddress:=Name & "!A1", TextToDisplay:=Name

Range("G2:G40").Select
With Selection.Font
.Name = "B Nazanin"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
Next e
End Sub

Amir Ghasemiyan

2013/12/23, 17:50

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

سلام دوست عزيز.
كاري كه شما ميخواين يكم پيچيده شده. شما بايد از همچين كدي استفاده كنيد

Sub ranking()
Dim s(3) As String
Dim q(3) As String
Sheets("Sheet1").Select
For i = 0 To 3
s(i) = Range("A1").Value
ActiveSheet.Next.Select
Next i
Sheets("Sheet1").Select
For i = 0 To 3
Range("G" & i + 1) = s(i)
Next i

For i = 0 To 3
q(i) = Range("H" & i + 1).Value
Next i
Sheets("Sheet1").Select
For i = 0 To 3
ActiveSheet.Next.Select
Range("A2").Value = q(i)
Next i

End Sub

منتها شما نياز دارين كه در sheet 1 در ستون H اين دستور رو وارد كنيد و براي مثلا 100 سلول بسط بدين

=RANK(G1;$G:$G)

ali65e

2013/12/23, 18:13

سلام.
امیر جان معدل ها توو سلول bi122 شیت ها قرار داره.شماره ی سلول رو کجای تابع بنویسم؟امیر جان بعد از این که این ماکرو انجام بشه، رتبه دانش آموزان کجا نوشته میشه؟

Amir Ghasemiyan

2013/12/23, 18:25

سلام.
امیر جان معدل ها توو سلول bi122 شیت ها قرار داره.شماره ی سلول رو کجای تابع بنویسم؟امیر جان بعد از این که این ماکرو انجام بشه، رتبه دانش آموزان کجا نوشته میشه؟

سلام دوست عزيز
اين خط رو اصلاح كنيد و بجاي A1 همون BI122 رو بذارين (خط 6)

s(i) = Range("A1").Value

رتبه دانش آموزان تو سلول A2 هر شيت نوشته ميشه (خط 19)

ali65e

2013/12/23, 19:41

امیر خان یه جایه کار میلنگه داداش.
من ماکرو رو اونجوری که گفتی تغییر دادم ولی ارور میده
Sub ranking()
Dim s(3) As String
Dim q(3) As String
Sheets("Sheet1").Select
For i = 0 To 3
s(i) = Range("bi122").Value
ActiveSheet.Next.Select
Next i
Sheets("Sheet1").Select
For i = 0 To 3
Range("G" & i + 1) = s(i)
Next i

For i = 0 To 3
q(i) = Range("H" & i + 1).Value
Next i
Sheets("Sheet1").Select
For i = 0 To 3
ActiveSheet.Next.Select
Range("A2").Value = q(i)
Next i

End Sub
داداش اون قسمت ماکرو که رنگی کردم ،اکسل براش debug میخواد.

Amir Ghasemiyan

2013/12/23, 21:39

امیر خان یه جایه کار میلنگه داداش.
من ماکرو رو اونجوری که گفتی تغییر دادم ولی ارور میده
Sub ranking()
Dim s(3) As String
Dim q(3) As String
Sheets("Sheet1").Select
For i = 0 To 3
s(i) = Range("bi122").Value
ActiveSheet.Next.Select
Next i
Sheets("Sheet1").Select
For i = 0 To 3
Range("G" & i + 1) = s(i)
Next i

For i = 0 To 3
q(i) = Range("H" & i + 1).Value
Next i
Sheets("Sheet1").Select
For i = 0 To 3
ActiveSheet.Next.Select
Range("A2").Value = q(i)
Next i

End Sub
داداش اون قسمت ماکرو که رنگی کردم ،اکسل براش debug میخواد.

دوست عزيز شما در sheet1 در ستون H اون فرمولي كه دادم خدمتتون وارد كردين؟
درضمن لطف كنيد كدهاتون رو داخل تگ كد بذارين تا مرتب تر باشه و بهتر بشه خوند

ali65e

2013/12/23, 22:00

امیر جان من حقیقتش کامل متوجه منظورتون نشدم که چطوری باید اون فرمولی رو که فرمودین رو در ستون h اعمال کنم!آیا اول باید روی کل ستون H کلیک کنم و سپس روی کل ستون پیست کنم یا اول باید روی سلول اول پیست کنم و سپس دوباره کپی بگیرم از روی سلول اول و بعد روی 100 سلول اول پیست کنم؟
چشم .از دفعه های بعد حتما این کاری رو که گفتید انجام میدم.

Amir Ghasemiyan

2013/12/23, 22:21

امیر جان من حقیقتش کامل متوجه منظورتون نشدم که چطوری باید اون فرمولی رو که فرمودین رو در ستون h اعمال کنم!آیا اول باید روی کل ستون h کلیک کنم و سپس روی کل ستون پیست کنم یا اول باید روی سلول اول پیست کنم و سپس دوباره کپی بگیرم از روی سلول اول و بعد روی 100 سلول اول پیست کنم؟
چشم .از دفعه های بعد حتما این کاری رو که گفتید انجام میدم.

دومي كه گفتين

يعني تو سلول h1 شما همچين فرمولي دارين:

=rank(g1;$g:$g)

تو سلول h2 اين فرمول رو خواهيم داشت:

=rank(g2;$g:$g)

و به همين ترتيب الي آخر.

چشمتونم بي بلا

ali65e

2013/12/23, 22:59

امیر جان فایلشو میذارم خدمتتون ببینید.بازم ارور میده

Amir Ghasemiyan

2013/12/24, 00:12

امیر جان فایلشو میذارم خدمتتون ببینید.بازم ارور میده

بفرماييد خدمت شما. يكسري اصلاحات انجام دادم. الان زير هر معدل رتبه رو هم مشخص ميكنه

ali65e

2013/12/27, 09:05

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

Amir Ghasemiyan

2013/12/27, 18:47

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

سلام مجدد دوست عزيز
فايل درست بود تقريبا. فكر كنم گفته بودم فايل نمونس و بايد اصلاح كنين. شايد هم نگفتم :cool:

اين كد اصلاح شده مطابق با فايلي كه الان گذاشتين

Sub ranking()
Dim s(100) As String
Dim q(100) As String
Sheets("Sheet1").Select
ActiveSheet.Next.Select
c = Range("I11").Value
ActiveSheet.Next.Select
For i = 0 To c - 1
ActiveSheet.Next.Select
s(i) = Range("Bi122").Value
Next i
Sheets("Sheet1").Select
For i = 0 To c - 1
Range("G" & i + 1) = s(i)
Next i
For i = 0 To c - 1
q(i) = Range("H" & i + 1).Value
Next i
Sheets("Sheet1").Select
ActiveSheet.Next.Select
ActiveSheet.Next.Select
For i = 0 To c - 1
ActiveSheet.Next.Select
Range("BI123").Value = q(i)
Next i
End Sub

ali65e

2013/12/27, 18:53

سلام مجدد دوست عزيز
فايل درست بود تقريبا. فكر كنم گفته بودم فايل نمونس و بايد اصلاح كنين. شايد هم نگفتم :cool:

اين كد اصلاح شده مطابق با فايلي كه الان گذاشتين

Sub ranking()
Dim s(100) As String
Dim q(100) As String
Sheets("Sheet1").Select
ActiveSheet.Next.Select
c = Range("I11").Value
ActiveSheet.Next.Select
For i = 0 To c - 1
ActiveSheet.Next.Select
s(i) = Range("Bi122").Value
Next i
Sheets("Sheet1").Select
For i = 0 To c - 1
Range("G" & i + 1) = s(i)
Next i
For i = 0 To c - 1
q(i) = Range("H" & i + 1).Value
Next i
Sheets("Sheet1").Select
ActiveSheet.Next.Select
ActiveSheet.Next.Select
For i = 0 To c - 1
ActiveSheet.Next.Select
Range("BI123").Value = q(i)
Next i
End Sub

ممنون داداش خوده خودشه.دمت گممممممممممممم:)

ali65e

2013/12/29, 19:13

امیر جان جسارتا یه مارکو می خوام که اطلاعات سلول های a1 شیت هایی که ماکرویه قبلی به تعداد دانش آموزان ایجاد کرده رو با هم جمع کنه و حاصل جمعشو تو سلول مثلا b1 بنویسه.متن مارکوهایی که فایلم با اون کار می کنه رو خدمتتون میذارم
ماکرویه 1

Sub sheetnaming()
Sheets("Sheet2").Select
c = Range("I11").Value
For e = 2 To c + 1
Name = Range("G" & e).Value
Sheets("Sheet20").Select
Sheets("Sheet20").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Name
ActiveSheet.Range("a1") = Name
Sheets("Sheet2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Range("G" & e), Address:="", SubAddress:=Name & "!A1", TextToDisplay:=Name

Range("G2:G40").Select
With Selection.Font
.Name = "B Nazanin"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
Next e
End Sub

ماکرویه 2

Sub oloom()

Dim s(100) As String
Dim q(100) As String
Sheets("Sheet1").Select
ActiveSheet.Next.Select
c = Range("I11").Value
ActiveSheet.Next.Select
For i = 0 To c - 1
ActiveSheet.Next.Select
s(i) = Range("MH1208").Value
Next i
Sheets("Sheet1").Select
For i = 0 To c - 1
Range("bn" & i + 1) = s(i)
Next i
For i = 0 To c - 1
q(i) = Range("bo" & i + 1).Value
Next i
Sheets("Sheet1").Select
ActiveSheet.Next.Select
ActiveSheet.Next.Select
For i = 0 To c - 1
ActiveSheet.Next.Select
Range("MG1208").Value = q(i)
Next i
End Sub

Amir Ghasemiyan

2013/12/29, 19:23

امیر جان جسارتا یه مارکو می خوام که اطلاعات سلول های a1 شیت هایی که ماکرویه قبلی به تعداد دانش آموزان ایجاد کرده رو با هم جمع کنه و حاصل جمعشو تو سلول مثلا b1 بنویسه.متن مارکوهایی که فایلم با اون کار می کنه رو خدمتتون میذارم

بفرماييد خدمت شما

Sub sums()
a = Range("A1").Value
For i = 1 To Worksheets.Count - 1
ActiveSheet.Next.Select
a = Range("A1").Value + a
Next i

Sheets("sheet1").Select
Range("B1").Value = a
End Sub

ali65e

2013/12/29, 19:33

بفرماييد خدمت شما

Sub sums()
a = Range("A1").Value
For i = 1 To Worksheets.Count - 1
ActiveSheet.Next.Select
a = Range("A1").Value + a
Next i

Sheets("sheet1").Select
Range("B1").Value = a
End Sub

دستت درد نکنه داداش.ممنون:o

ali65e

2013/12/29, 19:39

با عرض سلام خدمت دوستان و اساتید عزیز
دوستان فايل اکسلي دارم که با فرمت xlsm،آن را ذخيره کرده ام.دوستان مشکل اين جاست که وقتي همين فايل رو در کامپيوتر ديگري باز مي کنم با دو مشکل مواجه ميشود
1.اندازه ي سطر ها و ستون ها مقداري تغيير مي کنند
2.مشکل ديگر هم اين است که من تمام طراحي هام بر اساس مانيتور 17 اينچ بوده و فقط در صورتي که فايلم با اين مانيتور باز شود، تمام اشکال و جداول در وسط صفحه مانيتور نمايان مي شوند ولي در مانيتور هاي بزرگتر يا وايد، تصاويرم در گوشه مي افتند و در نتيجه جلوه و زيبايي خوبي ندارد .
دوستان چگونه مي تونم اين مشکل را برطرف کنم؟

ali65e

2013/12/29, 20:12

بفرماييد خدمت شما

Sub sums()
a = Range("A1").Value
For i = 1 To Worksheets.Count - 1
ActiveSheet.Next.Select
a = Range("A1").Value + a
Next i

Sheets("sheet1").Select
Range("B1").Value = a
End Sub

امیر آقا وقتی ماکرویه shettnaming اجرا میشه و بعدش ماکرویه sum رو اجرا بشه ،ارور میده.امیر آقا فایلشو میفرستم خدمتتون بهتر ببینید

Amir Ghasemiyan

2013/12/29, 22:41

امیر آقا وقتی ماکرویه shettnaming اجرا میشه و بعدش ماکرویه sum رو اجرا بشه ،ارور میده.امیر آقا فایلشو میفرستم خدمتتون بهتر ببینید

بفرماييد دوست عزيز. يك سري تغييرات جزئي نياز داشت

Sub sums()
Sheets("sheet1").Select
ActiveSheet.Next.Select
For i = 1 To Worksheets.Count - 2
ActiveSheet.Next.Select
a = Range("bi122").Value + a
Next i
Sheets("sheet1").Select
Range("B1").Value = a
End Sub

ali65e

2013/12/30, 16:31

بفرماييد دوست عزيز. يك سري تغييرات جزئي نياز داشت

Sub sums()
Sheets("sheet1").Select
ActiveSheet.Next.Select
For i = 1 To Worksheets.Count - 2
ActiveSheet.Next.Select
a = Range("bi122").Value + a
Next i
Sheets("sheet1").Select
Range("B1").Value = a
End Sub

ممنون داداش .خوده خودشه:o

ali65e

2014/01/04, 16:49

سلام خدمت دوستان و اساتید
دوستان ماکرویی دارم که با ران شدن این ماکرو، به تعداد اسامی دانش آموزان از شیت 20 کپی می گیرد و شیت درست می کند.دوستان مشکل اینجاست که این ماکرو حتما باید همان هنگامی که فایل باز می شود ران شود و اگر کمی در شیت 20تغییر ایجاد شود ،در اجرای این ماکرو به ارور بر می خوریم.دوستان ایا راهی برای برطرف کردن این ارور وجود دارد؟

Amir Ghasemiyan

2014/01/04, 23:04

سلام خدمت دوستان و اساتید
دوستان ماکرویی دارم که با ران شدن این ماکرو، به تعداد اسامی دانش آموزان از شیت 20 کپی می گیرد و شیت درست می کند.دوستان مشکل اینجاست که این ماکرو حتما باید همان هنگامی که فایل باز می شود ران شود و اگر کمی در شیت 20تغییر ایجاد شود ،در اجرای این ماکرو به ارور بر می خوریم.دوستان ایا راهی برای برطرف کردن این ارور وجود دارد؟

سلام دوست عزيز
عكستون واضح نيست. به چه مشكلي بر ميخوريد؟ چه تغيير در شيت 20 ميدين كه اين مشكل بوجود مياد؟

ali65e

2014/01/05, 18:10

سلام دوست عزيز
عكستون واضح نيست. به چه مشكلي بر ميخوريد؟ چه تغيير در شيت 20 ميدين كه اين مشكل بوجود مياد؟
سلام
امیر جان متن ارورش اینهpath not found:vb3ccd.tmp
هر گونه تغییر امیر آقا.حتی اگه یک سلول هم اضافه بشه این ارور بوجود میاد

Amir Ghasemiyan

2014/01/06, 10:56

سلام
امیر جان متن ارورش اینهpath not found:vb3ccd.tmp
هر گونه تغییر امیر آقا.حتی اگه یک سلول هم اضافه بشه این ارور بوجود میاد

سلام
ميتونين فايلتون رو اينجا بذارين؟

ali65e

2014/01/06, 17:59

سلام
ميتونين فايلتون رو اينجا بذارين؟
سلام
امیر جان مشکل برطرف شد.ممنون

Amir Ghasemiyan

2014/01/07, 08:53

سلام
امیر جان مشکل برطرف شد.ممنون

مشكلش چي بود؟

ali65e

2014/01/07, 15:44

مشكلش چي بود؟
سلام
نمیدونم امیر آقا.ولی ویندوزمو که عوض کردم درست شد

Amir Ghasemiyan

2014/01/07, 16:02

سلام
نمیدونم امیر آقا.ولی ویندوزمو که عوض کردم درست شد

سلام
پس مشكل از فايل نبود. سيستمتون مشكل پيدا كرده بود :o

ali65e

2014/01/17, 12:28

سلام مجدد خدمت دوستان و سروران گرامی
دوستان فبلا ماکرویی رو یکی از دوستان(آقای قاسمیان)نوشته بودند که با اجرای اون ماکرو به تعداد دانش آموزان،از شیت 20 کپی مگرفته می شد و شیت ایجاد می شد.مشکلی که الان باهاش مواجه شدم اینه که بعلت تعداد زیاد دانش آموزان ،فایل بسیار سنگین شده . حتی در بعضی کامپیوترها اجرا نمیشه.دوستان جسارتا می خواستم اگر بشود تغییری توو دستور این ماکرویی که خدمتتان میگذارم داد که بجای اینکه به تعداد دانش آموز از شیت 20 کپی ایجاد شود،به تعداد دانش آموزان فایل اکسل "به نام هر دانش آموز"ایجاد شود.با تشکر از همه ی زحمت کشان این سایت

Sub sheetnaming()
Sheets("Sheet2").Select
c = Range("I11").Value
For e = 2 To c + 1
Name = Range("G" & e).Value
Sheets("Sheet20").Select
Sheets("Sheet20").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Name
ActiveSheet.Range("a1") = Name
Sheets("Sheet2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Range("G" & e), Address:="", SubAddress:=Name & "!A1", TextToDisplay:=Name

Range("G2:G40").Select
With Selection.Font
.Name = "B Nazanin"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
Next e
End Sub

Amir Ghasemiyan

2014/01/17, 19:50

سلام مجدد خدمت دوستان و سروران گرامی
دوستان فبلا ماکرویی رو یکی از دوستان(آقای قاسمیان)نوشته بودند که با اجرای اون ماکرو به تعداد دانش آموزان،از شیت 20 کپی مگرفته می شد و شیت ایجاد می شد.مشکلی که الان باهاش مواجه شدم اینه که بعلت تعداد زیاد دانش آموزان ،فایل بسیار سنگین شده . حتی در بعضی کامپیوترها اجرا نمیشه.دوستان جسارتا می خواستم اگر بشود تغییری توو دستور این ماکرویی که خدمتتان میگذارم داد که بجای اینکه به تعداد دانش آموز از شیت 20 کپی ایجاد شود،به تعداد دانش آموزان فایل اکسل "به نام هر دانش آموز"ایجاد شود.با تشکر از همه ی زحمت کشان این سایت

Sub sheetnaming()
Sheets("Sheet2").Select
c = Range("I11").Value
For e = 2 To c + 1
Name = Range("G" & e).Value
Sheets("Sheet20").Select
Sheets("Sheet20").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Name
ActiveSheet.Range("a1") = Name
Sheets("Sheet2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Range("G" & e), Address:="", SubAddress:=Name & "!A1", TextToDisplay:=Name

Range("G2:G40").Select
With Selection.Font
.Name = "B Nazanin"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
With Selection.Font
.Color = -10477568
.TintAndShade = 0
End With
Next e
End Sub

سلام دوست عزيز
اين كار شدنيه ولي توصيه ميكنم همچين كاري نكنين. چون اگه اين رو تغيير بدين بعد مجبورين همه كدهاتون رو تغيير بدين
بچه ها رو كلاس بندي كنيد خب. هر كلاس مثلا ده بيست نفر باشن. يعني تو هر فايل ده بيست نفر فقط باشن. اگه براي هر كسي يك فايل بسازين بعد براي باز كردن و نمره دادن و ... به مشكل ميخورين.

ali65e

2014/01/17, 19:59

سلام دوست عزيز
اين كار شدنيه ولي توصيه ميكنم همچين كاري نكنين. چون اگه اين رو تغيير بدين بعد مجبورين همه كدهاتون رو تغيير بدين
بچه ها رو كلاس بندي كنيد خب. هر كلاس مثلا ده بيست نفر باشن. يعني تو هر فايل ده بيست نفر فقط باشن. اگه براي هر كسي يك فايل بسازين بعد براي باز كردن و نمره دادن و ... به مشكل ميخورين.
بله درسته فرمایشتون امیر آقا.ولی چاره ای دیگه فکر نکنم داشته باشم. امیر آقا حجم فایلم با 12 دانش آموز حدودا 7 مگ شده .!!!.امیر آقا اگه توو اکسس طراحی بشه این نرم افزار ،باز هم احتمال داره مشکل سنگینی فایل ایجاد بشه ؟

Amir Ghasemiyan

2014/01/17, 20:47

بله درسته فرمایشتون امیر آقا.ولی چاره ای دیگه فکر نکنم داشته باشم. امیر آقا حجم فایلم با 12 دانش آموز حدودا 7 مگ شده .!!!.امیر آقا اگه توو اکسس طراحی بشه این نرم افزار ،باز هم احتمال داره مشکل سنگینی فایل ایجاد بشه ؟

با دوازده دانش آموز نبايد انقدر حجم بره بالا. احتمالا مشكل از شيت 20 هست.
اين كاري كه ميكنم انجام بدين:
وارد شيت 20 بشين. سلول a1. حالا دكمه هاي تركيبي ctrl+end رو بزنين. اينو بهم بگين كه رو چه سلولي قرار ميگيره

در مورد اكسس هم بگم كه با اكسس حجم انقدر افزايش پيدا نميكنه ولي طراحيش براي كسي كه تا حالا اكسس كار نكرده يا كم كار كرده يكم مشكله

ali65e

2014/01/17, 22:07

با دوازده دانش آموز نبايد انقدر حجم بره بالا. احتمالا مشكل از شيت 20 هست.
اين كاري كه ميكنم انجام بدين:
وارد شيت 20 بشين. سلول a1. حالا دكمه هاي تركيبي ctrl+end رو بزنين. اينو بهم بگين كه رو چه سلولي قرار ميگيره

در مورد اكسس هم بگم كه با اكسس حجم انقدر افزايش پيدا نميكنه ولي طراحيش براي كسي كه تا حالا اكسس كار نكرده يا كم كار كرده يكم مشكله
امیر آقا سلولی که نشون میده Qdj2767 هست

Amir Ghasemiyan

2014/01/17, 22:26

امیر آقا سلولی که نشون میده Qdj2767 هست

پس مشكل از همونه.
شما بايد شيت 20 رو اصلاح كنيد. اون قسمت هايي كه لازم دارين رو تو يك شيت جديد كپي كنيد.(محدوده هر چه كمتر باشه بهتره). شيت 20 رو پاك كنيد و اين شيت جديد رو بذارين بجاي شيت 20 مشكلتون حل ميشه

ali65e

2014/01/18, 19:24

پس مشكل از همونه.
شما بايد شيت 20 رو اصلاح كنيد. اون قسمت هايي كه لازم دارين رو تو يك شيت جديد كپي كنيد.(محدوده هر چه كمتر باشه بهتره). شيت 20 رو پاك كنيد و اين شيت جديد رو بذارين بجاي شيت 20 مشكلتون حل ميشه
سلام
بله درسته فرمایشتون ،ولی امیر آقا اگه محدوده های خالی رو پاک کنم توو نمایش نرم افزار مشکل ایجاد خواهد شد.چون محدوده ها خیلی نزدیک هم میشن.مثلا هنگامی که کاربرمحدوده کارنامه رو میزنه ،محدوده دیگری هم بعلت نزدیکی با محدوده کارنامه دیده خواهد شد.

Amir Ghasemiyan

2014/01/18, 23:25

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

من نگفتم محدوده اي رو پاك كنيد. فقط گفتم قسمتي كه لازم دارين رو تو يك شيت ديگه كپي كنيد و شيت 20 رو كلا حذف كنيد.

ali65e

2014/01/28, 17:01

من نگفتم محدوده اي رو پاك كنيد. فقط گفتم قسمتي كه لازم دارين رو تو يك شيت ديگه كپي كنيد و شيت 20 رو كلا حذف كنيد.

با سلام خدمت دوستان و اساتید محترمم
امیر آقا این مشکل حجیم بودن فایلم هر کاریش کردم درست نشد.امیر آقا جسارتا اگه همون دستوری که به تعداد دانش آموزان فایل اکسل درست میشه رو اگه زحمت بکشین خیلی ممنون میشم. تشکر

Amir Ghasemiyan

2014/01/29, 07:42

با سلام خدمت دوستان و اساتید محترمم
امیر آقا این مشکل حجیم بودن فایلم هر کاریش کردم درست نشد.امیر آقا جسارتا اگه همون دستوری که به تعداد دانش آموزان فایل اکسل درست میشه رو اگه زحمت بکشین خیلی ممنون میشم. تشکر

سلام علي جان
شما لطف كن دوباره فايلتو بذار. من سعي ميكنم درستش كنم اگر نشد چشم اون كد رو مينويسم برات

~M*E*H*D*I~

2014/01/29, 08:57

پوزش میخوام بی مقدمه وارد بحث میشم

ولی یک نکته ای رو بار ها گفتم باز تکرار میکنم

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

Amir Ghasemiyan

2014/01/29, 09:06

پوزش میخوام بی مقدمه وارد بحث میشم

ولی یک نکته ای رو بار ها گفتم باز تکرار میکنم

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

بله مهدي جان. حق با شماست. در اصل بايد از پايگاه داده اكسس استفاده ميشد ولي اولا تعداد شيت ها خيلي زياد نيست دوما از اول اشتباها به سراغ اكسل رفتن