لماذ لا يعطيني الخيار في تحديد الورقة كي أختار نسخها

[onlymanly]

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

بس ياريت يعطيني خيار أختار مثل أي ورقة اريد كي ينسخ مثلها و يكتب اسم الحساب

و ممكن يكون العنوان : هل يمكن أن يعطيني الخيار؟؟؟

شكرا لله ثم للجميع

تم تعديل يناير 13, 2010 بواسطه onlymanly

[onlymanly]

هل من مساعدة؟

[احمد فضيله]

افكار جميلة و الله

انا كمان مستني معاك

[onlymanly]

اظن أني عرفت كيف اختيار الورقة أو النطاق المطلوب نسخه .. فقط أحاول أتعلم حسب وقتي ..

في الملف هذا الكود .. الذي في اللون الأحمر هو النطاق و الكحلي هو الورقة .. و يمكنك اختيار أي نطاق يتم نسخة و أي ورقة كذلك حسب اسمها لديك

والله اعلم

Private Sub CommandButton1_Click()

On Error Resume Next

Dim xlSheet As Worksheet

Dim xlSh As Worksheet

If Me.BackColor = 192 Then MsgBox "ÇáÇÓã ãÑÝæÖ äÕíÇð", vbInformation + vbMsgBoxRight, "ÊäÈíå": GoTo 1

If TextBox1.Text = "" Then MsgBox "ÎáÇíÇ ÝÇÑÛÉ ", vbInformation + vbMsgBoxRight, "ÊäÈíå": GoTo 1

For Each xlSh In ActiveWorkbook.Worksheets

If xlSh.Name = TextBox1.Text Then MsgBox "ÇÓã ãßÑÑ", vbInformation + vbMsgBoxRight, "ÊäÈíå": GoTo 1

Next xlSh

B = MsgBox(" åá ÊÑíÏ ÇÖÇÝÉ " & vbNewLine & "" & vbNewLine & "ÇáÍÓÇÈ : " & TextBox1.Text, vbOKCancel + vbQuestion + vbMsgBoxRight, "ÊÃßíÏ ÇÖÇÝÉ ÍÓÇÈ")

If B = 2 Then GoTo 1

Application.ScreenUpdating = False

Set xlSheet = ActiveWorkbook.Sheets.Add

With xlSheet

.Name = TextBox1.Text

33.Range("A1:K74").Copy

.Paste

.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

.[C3] = "ÍÓÇÈ / " & TextBox1.Text

.[A5].Select

End With

Application.CutCopyMode = False

With ActiveWindow

.FreezePanes = True

.DisplayGridlines = False

End With

Set xlSheet = Nothing

Application.ScreenUpdating = True

End

On Error GoTo 0

1 End Sub

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

السلام عليكم

لنفرض ان اسم الورقة التي تريدها "الناسخة"

Private Sub CommandButton1_Click()

On Error Resume Next

Dim xlSheet As Worksheet

Dim xlSh As Worksheet

If Me.BackColor = 192 Then MsgBox "الاسم مرفوض نصياً", vbInformation + vbMsgBoxRight, "تنبيه": GoTo 1

If TextBox1.Text = "" Then MsgBox "خلايا فارغة ", vbInformation + vbMsgBoxRight, "تنبيه": GoTo 1


For Each xlSh In ActiveWorkbook.Worksheets

    If xlSh.Name = Application.Trim(TextBox1.Text) Then MsgBox "اسم مكرر", vbInformation + vbMsgBoxRight, "تنبيه": GoTo 1

Next xlSh


B = MsgBox(" هل تريد اضافة " & vbNewLine & "" & vbNewLine & "الحساب :  " & TextBox1.Text, vbOKCancel + vbQuestion + vbMsgBoxRight, "تأكيد اضافة حساب")

If B = 2 Then GoTo 1

Application.ScreenUpdating = False

'===============================================

'       اسم الورقة التي تريد نسخها

Sheets("الناسخة").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)

'===============================================

Set xlSheet = ActiveSheet

With xlSheet

    .Name = TextBox1.Text

    .[L6] = TextBox1.Text

End With

Set xlSheet = Nothing

Application.ScreenUpdating = True

End

On Error GoTo 0

1 End Sub

شاهد المرفق

نسخ صفحات1.rar

[onlymanly]

:) دائما اطلاتك كإطلالة القمر للساري في ظلم الليل... زادناالله من فضله و إياك

[الجزيرة]

كم أنت رائع أخي عبد الله

رائع بفكرك وخلقك ، ملف أكثر من رائع كما هي عادتك : )

[onlymanly]

أخي خبور خير..

ولا عيب فيهم غير أن سيوفهم..... بهنَّ فلول من قراع الكتائب

تم تعديل فبراير 11, 2010 بواسطه onlymanly

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

السلام عليكم

اخي الفاضل ONLY------حفظه الله

هل بإمكانك جعله يكتب إسم الورقة حسب فورم النسخ في مكان معين من الورقة .؟؟؟

طبعا انت حتغير الورقة الناسخة حسب ما تريده

هنا في المثال اخترنا الخلية [L6] للاسم حسب فورم النسخ

وطبعا انت حتغيره حسب ورقتك المختارة

With xlSheet

    .Name = TextBox1.Text

    .[L6] = TextBox1.Text

End With

وقد وضعت ملف من سابق احدث من ده في المنتدى

ساعطيك رابطه اذا وجدته

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

====================================

اخي الفاضل الجزيرة------حفظه الله

الله يكرمك

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

تم تعديل فبراير 11, 2010 بواسطه خبور خير

[خالد القدس]

السلام عليكم سلمت يمينك أستاذ خبور أكواد رهيبة عجيبة

[onlymanly]

بارك الله فيك أخي خبور خير....

اتساءل لماذا عند استخدام فورم العودة إلى الصفحة الرئيسية لا يعمل ملفك بشكل صحيح ؟؟

أتمنى أن تلقي نظرة على الملف ..

و العفو ع كثرة الطلبات

[onlymanly]

شكل الملف لم يرتفع .. سأرفقه مرة أخرى

تم تعديل فبراير 12, 2010 بواسطه onlymanly

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

السلام عليكم

عندك اكواد في موديل الورقة الناسخة

يجب ايقاف تشغيلها

غير الجزئية هذه من الكود:

Application.ScreenUpdating = False

'===============================================

'       اسم الورقة التي تريد نسخها

Sheets("الناسخة").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)

'===============================================

Set xlSheet = ActiveSheet

With xlSheet

    .Name = TextBox1.Text

    .[F3] = TextBox1.Text

End With

Set xlSheet = Nothing

Application.ScreenUpdating = True

بهذه الجزئية:

Application.ScreenUpdating = False

Application.EnableEvents = False

'===============================================

'       اسم الورقة التي تريد نسخها

Sheets("الناسخة").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)

'===============================================

Set xlSheet = ActiveSheet

With xlSheet

    .Name = TextBox1.Text

    .[F3] = TextBox1.Text

End With

Set xlSheet = Nothing

Application.EnableEvents = True

Application.ScreenUpdating = True

[onlymanly]

فعلا لا مشكلة بفضل الله ثم بلمساتك..

أستاذ كبير ما شاء الله عليك