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

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

قام بنشر

الاخوه الكرام تحيه طيبه وبعد

ارجو الساعده فى عمل الاتى اريد بعد الضغط على زر انشاء شيت جديد وظهور USERFORM1 اريد ان اقوم بكتابة اسم او رقم فى TEXT BOX1 ثم الضغط على زر اضافة شيت فيتم انشاء شيت جديد فارغ بنفس الاسم الذى تم كتابته فى TEXT BOX1

اضافة شيت.rar

قام بنشر

السلام عليكم

حط هذا الكود في حدث الفورم


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

قام بنشر

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

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

نسال الله سبحانه وتعالى ان يديم نعمه عليك ويعطيك الصحة والعافية

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

قام بنشر

السلام عليكم

وهذا حل اخر , اضافة للحل في المشاركة رقم2


Private Sub CommandButton1_Click()

  Sheets.Add After:=Sheets(Sheets.Count)

	Sheets(Sheets.Count).Select

	Sheets(Sheets.Count).Name = TextBox1.Text

End Sub

قام بنشر

السلام عليكم

جرب هكذا


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

قام بنشر

بعد أذن الأخ الفاضل / 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

قام بنشر

بعد أذن الأخ الفاضل / 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

الاستاذ رجب جاويش

لمسات محترفة من شخص محترف

قام بنشر

الاستاذ رجب

ما رأيك بهذا التعديل


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

قام بنشر

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

بارك الله فيكم جميع المشاركين

ولاثراء الموضوع

هناك ايضا موانع اخرى لتسمية ورقة العمل

وهي :

- طول الاسم يجب الا يكون اكبر من 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

ودمتم

قام بنشر

السلام عليكم

إختصار للكود


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

قام بنشر

السلام عليكم

أستاذنا الحبيب عبدالله باقشير حفظك الله ورعاك

دالة جميله وأكوادك كالعادة إحترافيه

وفقك الله

قام بنشر

ألاستاذ عبدالله

نبقى تلاميذ صغار امامك

الأخ /thair younus

تسلم ايديك

الأستاذ / عبد الله باقشير

دائما أستاذ الأساتذة

بارك الله فيك

بارك الله فيكم وجزاكم الله خيرا

تقبلوا تحياتي وشكري

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.

×
×
  • اضف...

Important Information