سالي

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

انا اسفة اني علقت علي الطبع والله ما قصدي الا ان اخفف من طلباتي ممتاز جدا تسلم ايها الاستاذ العظيم والعظمة لله لكن ملاحظة صغيرة لدي نقل الكود الي برنامجي واسم المايكرو فيه هو ( طبع_فاتورة_المبيعات ) يظهر خطأ حتي بعد ان عدلت التالي Public Sub Ali_Sale() Public Sub طبع_فاتورة_المبيعات() وهذا هو الكود والذي ساستنسخة لطبع اتسديد العملاء والموردين بعد تعديل اللازم وهو يعمل ممتاز في الشيت الذي تفضلت حضرتك بارفاقه Public Sub Ali_Sale() Nm_Work = " مبيعات" save_file Path_A, [I5], Nm_Work End Sub Public Sub save_file(Path_x As String, m_r As Range, ByVal Fom_n As String) Dim full_path As String Dim aah As String Dim Ali_Num$ Dim Num% If ActiveSheet.CheckBox1.Value = True Then '*************************** Ali_Num = InputBox("ادخل عدد نسخ الطبع") If Ali_Num = "False" Or Ali_Num = Cancel Then Exit Sub On Error Resume Next '*************************** For Num = 1 To Ali_Num Activewindow.SelectedSheets.PrintOut Next '*************************** Exit Sub Else GoTo 1 End If 1: If Range("i5") = "" Then MsgBox ("ادخل رقم الفاتورة") Exit Sub Else m = ActiveWorkbook.Name Workbooks.Add N = ActiveWorkbook.Name Windows(m).Activate ActiveSheet.Range("b1:j23").Copy Windows(N).Activate ActiveSheet.Range("b1:j23").Select ActiveSheet.Paste Range("b1:j23").Select Selection.Copy Range("b1:j23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("b:J").EntireColumn.AutoFit Range("b1").Select Application.CutCopyMode = False Application.DisplayAlerts = False If aah = [I5] & ".xls" Then MsgBox "الملف موجود بالفعل..." ActiveWorkbook.Close Application.DisplayAlerts = True Exit Sub Else '************************************************* ActiveWorkbook.SaveAs Filename:=Path_x & m_r & Fom_n '************************************************* Application.DisplayAlerts = True ActiveWorkbook.Close Application.DisplayAlerts = False ThisWorkbook.Save Application.DisplayAlerts = True End If End If End Sub اتصور لازم اقوم بتعديل شيء حتي يعمل معي الله يبارك فيك يارب

الله يبارك فيك استاذ ابو نصار الله يجازيك عني خيرا اكثر من رائع وان شاء الله احاول اني اتابع اكواد الطباعة حتي اتمكن من التحكم في عدد نسخ الطبع لان هذا الكود يطبع نسخة واحدة If ActiveSheet.CheckBox1.Value = True Then Activewindow.SelectedSheets.PrintOut والله والله اعجز عن شكركم حفظكم الله

الاستاذ الفاضل ابو نصار مرفق شيت الفاتورة وهو في الاصل لاحد الاساتذة في هذا المنتدي عند الضغط علي طبع " الفاتورة رقم 2 " ينسخ الفاتورة بشيت مستقل في نفس الفولدر ويكون الاسم "مبيعات 2 " وعند تغيير رقم الفاتورة الي 3 ينسخ شيت "مبيعات 3 " وهكذا الا اني اتمني ان يكون النسخ في فولدر اسمه مبيعات موجود في فولدر فواتير بال D وبنفس الالية ( مبيعات 1 ومبيعات 2 ومبيعات 3 وهكذا حيث سيكون بفولدر الفواتير فولدر لمدفوعات الموردين وايضا فولدر لمقبوضات العملاء ) ايضا في بداية الكود امر طباعة نسخة ممكن تعديله ليكون نسختين او اكثر وااسف لاني اخذت من و قتكم بارك الله فيكم ولكم كل شكري الفاتورة

<p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>الاستاذ ابو نصار</strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>مرفق شيت الفاتورة وهو في الاصل لاحد الاساتذة في هذا المنتدي </strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>عند الضغط علي &quot; طبع &quot; للفاتورة رقم 2 ينسخ الفاتورة بشيت مستقل في نفس الفولدر </strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>ويكون الاسم &quot;مبيعات 2&quot; وعند تغيير رقم الفاتورة الي 3 ينسخ شيت باسم </strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>&quot;مبيعات 3 &quot; وهكذا </strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>الا اني اتمني ان يكون النسخ في فولدر اسمه مبيعات موجود في فولدر فواتيير بال D</strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>وبنفس الالية مبيعات 1 ومبيعات 2 ومبيعات 3 وهكذا</strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>حيث سيكون بفولدر الفواتير فولدر لمدفوعات الموردين وايضا فولدر لمقبوضات العملاء</strong></span></p> <p style="text-align: center;"> </p> <p style="text-align: center;"><span style="color: rgb(178, 34, 34);"><strong>ايضا في بداية الكود امر طباعة &quot; نسخة &quot; ممكن تعديله ليكون نسختين او اكثر؟؟</strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>وااسف لاني اخذت من وقتكم بارك الله فيكم</strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>ولكم كل شكري</strong></span></p> فاتورة.rar

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

الاستاذ ابو نصار لدي تطبيق الكود اتضح انه ينسخ الفاتورة باسم مبيعات ويضعها في فولدر الفواتير ولا ينقلها لفولدر المبيعات ايضا اتمني يكون اسم شيت الفاتورة ليس مبيعات فقط بل مبيعات ورقم الفاتورة " مبيعات 8 " مثلا مع شكري لكم سلفا

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

الاساتذة الكرام ابو حنين وابو نصار حفظكما الله حقيقي انا اسفة جدا لكثرة طلباتي لكن طمعي في سعة صدركم وعلمكم وتخصص المنتدي يجعلني طماعة شوية كود الطباعة يقوم بعمل نسخة ويحفظها بنفس الفولدر وبما انه يتم الاحتفاظ بنسخ من فواتير المبيعات ومدفوعات الموردين ومقبوضات العملاء في فولدر الفواتير الذي سيكون فيه فولدر للمبيعات وايضا الموردين كذلك العملاء فاتمني تعديل الكود بحيث يكون الحفظ في D/فواتير/المبيعات وسأطبقة علي الباقي الله يبارك بكم وهناك استفسار اخر هل ممكن ان تكون حماية ورقة المشتريات مثلا بكلمة مرور يقوم الكود بفكها وبعد الترحيل يحمها بنفس كلمة المرور لاني حاولت ذلك ولم ينفع الا بالحماية بدون كلمة مرور شاكرة لكم مرة ثانية سعة الصدر If ActiveSheet.CheckBox1.Value = True Then Activewindow.SelectedSheets.PrintOut Else GoTo 1 End If حفظ الفاتورة في ملف منفصل 1: If Range("i5") = "" Then MsgBox ("ادخل رقم الفاتورة") Exit Sub Else Dim full_path As String Dim aah As String m = ActiveWorkbook.Name full_path = ThisWorkbook.Path & "\" & [i5].Value & " مبيعات" Debug.Print full_path Workbooks.Add N = ActiveWorkbook.Name Windows(m).Activate ActiveSheet.Range("b1:j11").Copy Windows(N).Activate ActiveSheet.Range("b1:j16").Select ActiveSheet.Paste Range("b1:j16").Select Selection.Copy Range("b1:j16").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("b:J").EntireColumn.AutoFit Range("b1").Select Application.CutCopyMode = False Application.DisplayAlerts = False If aah = [i5] & ".xls" Then MsgBox "الملف موجود بالفعل..." ActiveWorkbook.Close Application.DisplayAlerts = True Exit Sub Else ActiveWorkbook.SaveAs Filename:=full_path Application.DisplayAlerts = True ActiveWorkbook.Close Application.DisplayAlerts = False ThisWorkbook.Save Application.DisplayAlerts = True End If End If End Sub

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

الاساتذة الكرام كود الاستاذ ابو حنين استطعت ان اضيف كود الغاء حماية الورقة قبل نقل البيانات لها ومن ثم اعادة الحماية لها لكن كود الاستاذ ابو نصار حاولت كثيرا لكن لم اوفق الرجاء اعلامي اين اكتبه في كود الاستاذ ابو نصار الكود هو [/center] [center] Sheets("المشتريات").Select ActiveSheet.Unprotect وبعد اتمام الكود يكون الامر ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True[/center] [center]

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

للرفع

للرفع

الاستاذ واخي الفاضل ابو حنين اامل الاطلاع علي الملف المرفق ومراجعة الكود لمعالجة الحالة مع كل التقدير لكم Book1.rar