زر اضاف شيت جديد لكن الشيت الجديد يكون منسق مسبقا

[abdulkreem]

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

اما بعد

اريد ان اشكر كل القائمين على هذا المنتدى حيث اته منتدى علمي 100 %

وسوف ابدا بمشاركتي الاولى بسؤال طال البحث عن اجابته

وهو

اريد اضاف شيت جديد لكن الشيت الجديد يكون منسق مسبقا

بمعنى

الشيت رقم 1 منسق بجداول معينة

اريد زر عند الضغط عليه تاتي رسالة بامر ادخال اسم الشيت وبعد ادخال اسم الشيت

ينشاء شيت جديد حسب الاسم المدخل وبنفس التنسيق لشيت رقم 1

الان كود انشاء شيت بادخال الاسم جديد هذا هو

Sub NweSheeetCustomeName()

On Error GoTo ErrorHandler


Dim NewSheet As Worksheet

Dim SheetName As String


Set NewSheet = Sheets.Add


SheetName = InputBox("Please Insert sheet name.")


If SheetName = "" Or Len(SheetName) > 31 Then

MsgBox ("You did not insert a name OR sheet name lenth is greater than 31 Characther")

Exit Sub

End If


NewSheet.Name = SheetName


ErrorHandler:

If Err.Number = 1004 Then

MsgBox ("This name already exist")

Application.DisplayAlerts = False

NewSheet.Delete

Application.DisplayAlerts = True

Exit Sub

End If


End Sub

كود انشاء شيت بتنسيق مسبق

Sheets("Sheet2").Select

Sheets("Sheet2").Copy After:=Sheets(2)

End Sub

تحياتي

ارجو ان اجد الجواب الوافي عند منتداكم

[محمد يحياوي]

تفضل اخي الكريم

انشاء ورقة بتنسيق مسبق.rar

[عبدالله باقشير]

السلام عليكم

بارك الله فيك اخي يحياوي

ائراءا للموضوع:

المرفق 2003

نسخ ورقة كعينة.rar

[abdulkreem]

برنامج ادارة مستودعات معدات20121011112158.rar

شكرا جزيلا جزاكم الله خيرا

اريد طلب اخير

حيث انني اعمل على انشاء برنامج مستودعات

والفكرة كتالي انه لكل ادات كرت خاص به وهو الشيت المضاف والمنسق مسبقا

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

المشكلة الموجهة هنا

انه عند اضافة الشيت اريد ايضا اضافة مجموعة خلية في الشيت الرئسي تلقائي

والملف المرفق يوضح كلامي

وباذن الله بعد الانتهاء من صنع البرنامج سوف ارفق نسخة للمنتدى

وشكرا وجزاكم الله خيرا

لقد استفدت فعلا

تحياتي

[الـعيدروس]

السلام عليكم

بعد اذن استاذنا الحبيب عبدالله باقشير

جرب هذا التعديل على الكود

Sub kh_CopySheet()

On Error GoTo ErrorHandler

''''''''''''''''''''''''

Dim NewSheet As Worksheet

Dim SheetName

Dim Sh As Worksheet

Dim C, C_1

Set Sh = Sheets("الرئيسية")

'''''''''''''''''''''''''''''''

SheetName = InputBox("Please Insert sheet name.")

If SheetName = Cancel Then Exit Sub

If kh_Test_MyChr(CStr(SheetName)) = True Then Exit Sub

''''''''''''''''''''''''''''''''

Set NewSheet = Sheets("CopySheet")

NewSheet.Copy After:=Sheets(ThisWorkbook.Worksheets.Count)

Set NewSheet = ActiveSheet

''''''''''''''''''''''''

With NewSheet

    .Visible = xlSheetVisible

    .Name = CStr(SheetName)

End With

With Sh

C = .Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row

C_1 = NewSheet.Cells(Rows.Count, 3).End(xlUp).Row

For Rr = 5 To 106

    For Cc = 3 To 7

   .Cells(Rr, Cc) = "=" & "'" & NewSheet.Name & "'" & "!" & .Cells(Rr, Cc).Address(False, False)

    Next

Next

End With

''''''''''''''''''''''''''

ErrorHandler:

If Err Then MsgBox "Err.Number : " & vbCr & Err.Number

Set NewSheet = Nothing

End Sub

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

[abdulkreem]

استاذي الكريم الكود قريب من فكرتي لكن لم ينفع الكود

هو قريب لكن يضيف الف خلية معه

حاولت البحث بالغةالانجليزية لم ينفع ايضا

if create new sheet creat new cells ........

والذي اريده عند اضافة شيت جديد منسق مسبقة اضافة خلية مقترنة مع الخلية الاخرة المحددة

مثل انه

الشيت المنسق

فيه 1- اسم المعدات 2- رقم المعد 3- نوعه 4- الكمية

وموجدات بالخلية , c3 , c4 d8

الان يوجد شيء اسمه الرئيسي حيث يبن اخر الاحدثات لجميع المعدات المضافة

في حال اضا فة شيت جديد وادخال البيانات في الشيت الجديد اوتو ماتكي ينشىء مجموعة من الخلية في شيت الرئسي مقترنة مع البيانات المدخلة

او اذا يوجد طريقة الترحيل البيانات

هذا الذي اريده