إبراهيم ابوليله قام بنشر أبريل 21, 2012 مشاركة قام بنشر أبريل 21, 2012 الاخوه الكرام تحيه طيبه وبعد ارجو الساعده فى عمل الاتى اريد بعد الضغط على زر انشاء شيت جديد وظهور USERFORM1 اريد ان اقوم بكتابة اسم او رقم فى TEXT BOX1 ثم الضغط على زر اضافة شيت فيتم انشاء شيت جديد فارغ بنفس الاسم الذى تم كتابته فى TEXT BOX1 اضافة شيت.rar رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر أبريل 21, 2012 مشاركة قام بنشر أبريل 21, 2012 السلام عليكم حط هذا الكود في حدث الفورم Private Sub CommandButton1_Click() Dim SH As Worksheet A = Me.TextBox1 Set SH = Worksheets.Add SH.Name = A SH.Move After:=Sheets(Sheets.Count) ActiveSheet.DisplayRightToLeft = False End Sub رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر أبريل 21, 2012 مشاركة قام بنشر أبريل 21, 2012 السلام عليكم ورحمة الله وبركاته الاستاذ الفاضل ابو نصار يعطيك الف عافية جربت الكود وكان رائعا لانني الحقيقة محتاج الكود للعمل عليه نسال الله سبحانه وتعالى ان يديم نعمه عليك ويعطيك الصحة والعافية والسلام عليكم ورحمة الله وبركاته رابط هذا التعليق شارك More sharing options...
حامد يونس قام بنشر أبريل 21, 2012 مشاركة قام بنشر أبريل 21, 2012 السلام عليكم وهذا حل اخر , اضافة للحل في المشاركة رقم2 Private Sub CommandButton1_Click() Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Select Sheets(Sheets.Count).Name = TextBox1.Text End Sub رابط هذا التعليق شارك More sharing options...
إبراهيم ابوليله قام بنشر أبريل 22, 2012 الكاتب مشاركة قام بنشر أبريل 22, 2012 اضافة شيت.rar الاخوه الكرام مشكورا لمجهوداتكم ولكنى اريد ايضا عمل الاتى منع تكرار كتابه اسم مرتين رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر أبريل 22, 2012 مشاركة قام بنشر أبريل 22, 2012 السلام عليكم جرب هكذا Private Sub CommandButton1_Click() Dim SH As Worksheet Dim T As Worksheet A = Me.TextBox1 For Each T In Application.Worksheets If Not T.Name = A Then GoTo 0 Else M = M & "إسم الورقة موجود مسبقاً" GoTo 1 End If Next T Exit Sub 0: Set SH = Worksheets.Add SH.Name = A SH.Move After:=Sheets(Sheets.Count) ActiveSheet.DisplayRightToLeft = False Exit Sub 1: MsgBox M End Sub رابط هذا التعليق شارك More sharing options...
رجب جاويش قام بنشر أبريل 22, 2012 مشاركة قام بنشر أبريل 22, 2012 بعد أذن الأخ الفاضل / thair younus هذا تعديل بسيط على الكود لمنع تكرار أسماء الصفحات وأيضا لا يسمح بترك الاسم فارغا Private Sub CommandButton1_Click() Dim sh As Worksheet If TextBox1.Text = "" Then MsgBox "ÇÓã ÇáÔíÊ áÇ íäÈÛì Ãä íßæä ÝÇÑÛÇ": Exit Sub For Each sh In ThisWorkbook.Worksheets If sh.Name = TextBox1.Text Then MsgBox "åÐÇ ÇáÇÓã ãæÌæÏ ãä ÞÈá", vbOKOnly, "ÇÓã ÔíÊ ãßÑÑ": Exit Sub Next Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Select Sheets(Sheets.Count).Name = TextBox1.Text TextBox1.Text = "" Me.Hide End Sub اضافة شيت.rar رابط هذا التعليق شارك More sharing options...
حامد يونس قام بنشر أبريل 22, 2012 مشاركة قام بنشر أبريل 22, 2012 بعد أذن الأخ الفاضل / thair younus هذا تعديل بسيط على الكود لمنع تكرار أسماء الصفحات وأيضا لا يسمح بترك الاسم فارغا Private Sub CommandButton1_Click() Dim sh As Worksheet If TextBox1.Text = "" Then MsgBox "ÇÓã ÇáÔíÊ áÇ íäÈÛì Ãä íßæä ÝÇÑÛÇ": Exit Sub For Each sh In ThisWorkbook.Worksheets If sh.Name = TextBox1.Text Then MsgBox "åÐÇ ÇáÇÓã ãæÌæÏ ãä ÞÈá", vbOKOnly, "ÇÓã ÔíÊ ãßÑÑ": Exit Sub Next Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Select Sheets(Sheets.Count).Name = TextBox1.Text TextBox1.Text = "" Me.Hide End Sub الاستاذ رجب جاويش لمسات محترفة من شخص محترف رابط هذا التعليق شارك More sharing options...
إبراهيم ابوليله قام بنشر أبريل 23, 2012 الكاتب مشاركة قام بنشر أبريل 23, 2012 مشكورا لكم اهتمامك وبارك الله فيكم رابط هذا التعليق شارك More sharing options...
حامد يونس قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 الاستاذ رجب ما رأيك بهذا التعديل Private Sub CommandButton1_Click() Dim cnt As Integer cnt = Sheets.Count For i = 1 To cnt If Sheets(i).Name = TextBox1.Value Then MsgBox "åÐÇ ÇáÇÓã ãæÌæÏ ãÓÈÞÇ" Exit Sub End If Next Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Select Sheets(Sheets.Count).Name = TextBox1.Text End Sub رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 السلام عليكم ورحمة الله وبركاته بارك الله فيكم جميع المشاركين ولاثراء الموضوع هناك ايضا موانع اخرى لتسمية ورقة العمل وهي : - طول الاسم يجب الا يكون اكبر من 31 - وبعض الاحرف ممنوعة في التسمية MyChArray = Array("/", "*", ":", "؟", "?", "[", "]") هذه دالة تشمل جميع الموانع لاسم الورقة يمكن استخدامها داخل الكود Function kh_Test_MyChr(KhString As Variant) As Boolean Dim MySh As Worksheet Dim MyChArray, MyChr Dim S As Integer, R As Integer S = Len(Trim(KhString)) If S > 31 Or S = 0 Then MsgBox "حروف الاسم قد تكون اصغر من 1 او اكبر من 31", 524288 + 1048576 + 16, "اسم مرفوض" kh_Test_MyChr = True Exit Function End If '------------------------------------ MyChArray = Array("/", "*", ":", "؟", "?", "[", "]") For Each MyChr In MyChArray If InStr(1, KhString, MyChr, 1) <> 0 Then MsgBox "حروف الاسم تحتوي على الحرف " & Chr(10) & Chr(10) & Chr(9) & MyChr & Chr(10) & Chr(10) & "وهو من الاحرف الممنوعة " & "/ * : ؟ [ ]", 524288 + 1048576 + 16, "حرف ممنوع" kh_Test_MyChr = True Exit Function End If Next '------------------------------------ For Each MySh In ActiveWorkbook.Sheets If UCase(Trim(MySh.Name)) = UCase(Trim(KhString)) Then MsgBox "الاسم مكرر ", 524288 + 1048576 + 16, "اسم مكرر" kh_Test_MyChr = True Exit Function End If Next End Function وهذا كود الاضافة بمعية الدالة Sub kh_Addsheet() Dim MyName As String Dim xlSheet As Worksheet MyName = TextBox1.Value If kh_Test_MyChr(MyName) = True Then Exit Sub Set xlSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)) xlSheet.Name = MyName Set xlSheet = Nothing End Sub ودمتم رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 السلام عليكم إختصار للكود Private Sub CommandButton1_Click() Dim T As Worksheet For Each T In Application.Worksheets If Not T.Name = Me.TextBox1 And Not Me.TextBox1 = Empty Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Me.TextBox1: Exit Sub Else: MsgBox "مسمى مكرر": Exit Sub End If Next T End Sub رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 السلام عليكم أستاذنا الحبيب عبدالله باقشير حفظك الله ورعاك دالة جميله وأكوادك كالعادة إحترافيه وفقك الله رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 وهناك ملاحظة اثناء نسخ كود فيه كلمات عربية قبل النسخ حول اللغة في الاكسل الى العربية ثم قم بالنسخ ستظهر اللغة العربية بشكلها الصحيح وليست طلاسم ودمتم رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 السلام عليكم أستاذنا الحبيب عبدالله باقشير حفظك الله ورعاك دالة جميله وأكوادك كالعادة إحترافيه وفقك الله بارك الله فيك اخي ابو انصار تقبل تحياتي وشكري رابط هذا التعليق شارك More sharing options...
حامد يونس قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 ألاستاذ عبدالله نبقى تلاميذ صغار امامك رابط هذا التعليق شارك More sharing options...
رجب جاويش قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 الأخ /thair younus تسلم ايديك الأستاذ / عبد الله باقشير دائما أستاذ الأساتذة بارك الله فيك رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أبريل 23, 2012 مشاركة قام بنشر أبريل 23, 2012 ألاستاذ عبدالله نبقى تلاميذ صغار امامك الأخ /thair younus تسلم ايديك الأستاذ / عبد الله باقشير دائما أستاذ الأساتذة بارك الله فيك بارك الله فيكم وجزاكم الله خيرا تقبلوا تحياتي وشكري رابط هذا التعليق شارك More sharing options...
إبراهيم ابوليله قام بنشر أبريل 23, 2012 الكاتب مشاركة قام بنشر أبريل 23, 2012 الاخوه الاساتذه الافاضل بارك الله فيكم وجعلم دائما فيمن ينفعون بعلمهم رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان