سالي قام بنشر ديسمبر 5, 2012 الكاتب قام بنشر ديسمبر 5, 2012 الله يبارك بك استاذ ابو نصار ويجعلك عونا لكل محتاج من فيض علمكم الذي ادعو الله ان يكون في ميزان حسناتك
الـعيدروس قام بنشر ديسمبر 5, 2012 قام بنشر ديسمبر 5, 2012 الاخ الكريم سالي اشكرك على كلماتك الطيبه ولك مثل دعائك أضعاف مضاعفه إن شاء الله تقبل تحياتي وشكري
سالي قام بنشر ديسمبر 5, 2012 الكاتب قام بنشر ديسمبر 5, 2012 الاستاذ ابو نصار لدي تطبيق الكود اتضح انه ينسخ الفاتورة باسم مبيعات ويضعها في فولدر الفواتير ولا ينقلها لفولدر المبيعات ايضا اتمني يكون اسم شيت الفاتورة ليس مبيعات فقط بل مبيعات ورقم الفاتورة " مبيعات 8 " مثلا مع شكري لكم سلفا
سالي قام بنشر ديسمبر 5, 2012 الكاتب قام بنشر ديسمبر 5, 2012 اسفة كتبت طلبي قبل ان اقرأ ردكم انا اخت لك في الله مع خالص شكري استاذ ابو نصار
الـعيدروس قام بنشر ديسمبر 5, 2012 قام بنشر ديسمبر 5, 2012 السلام عليكم الاخت الكريمة سالي اذهبي الى هذ السطر في الكود full_path = "D:\فواتير\المبيعات" 'ThisWorkbook.Path & "\" & [i5].Value & " مبيعات وأستبدليه بهذا full_path = "D:\فواتير\المبيعات" & "\" 'ThisWorkbook.Path & "\" & [i5].Value & " مبيعات" وخصوص تسمية الورقة بأسم الفاتور وأسم الورقة لم ارى اي سطر في الكود يقوم بما ذكرتيه ارجو ارفاق نسخه من ملفك ولو به بيانات خاصه اضفيفي بيانات وهميه وارفقيه وإن شاء الله سيتم عمل اللازم
سالي قام بنشر ديسمبر 5, 2012 الكاتب قام بنشر ديسمبر 5, 2012 (معدل) <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>عند الضغط علي " طبع " للفاتورة رقم 2 ينسخ الفاتورة بشيت مستقل في نفس الفولدر </strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>ويكون الاسم "مبيعات 2" وعند تغيير رقم الفاتورة الي 3 ينسخ شيت باسم </strong></span></p> <p style="text-align: center;"><span style="color: rgb(0, 0, 205);"><strong>"مبيعات 3 " وهكذا </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>ايضا في بداية الكود امر طباعة " نسخة " ممكن تعديله ليكون نسختين او اكثر؟؟</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 تم تعديل ديسمبر 5, 2012 بواسطه سالي
سالي قام بنشر ديسمبر 5, 2012 الكاتب قام بنشر ديسمبر 5, 2012 (معدل) الاستاذ الفاضل ابو نصار مرفق شيت الفاتورة وهو في الاصل لاحد الاساتذة في هذا المنتدي عند الضغط علي طبع " الفاتورة رقم 2 " ينسخ الفاتورة بشيت مستقل في نفس الفولدر ويكون الاسم "مبيعات 2 " وعند تغيير رقم الفاتورة الي 3 ينسخ شيت "مبيعات 3 " وهكذا الا اني اتمني ان يكون النسخ في فولدر اسمه مبيعات موجود في فولدر فواتير بال D وبنفس الالية ( مبيعات 1 ومبيعات 2 ومبيعات 3 وهكذا حيث سيكون بفولدر الفواتير فولدر لمدفوعات الموردين وايضا فولدر لمقبوضات العملاء ) ايضا في بداية الكود امر طباعة نسخة ممكن تعديله ليكون نسختين او اكثر وااسف لاني اخذت من و قتكم بارك الله فيكم ولكم كل شكري الفاتورة تم تعديل ديسمبر 5, 2012 بواسطه سالي
الـعيدروس قام بنشر ديسمبر 5, 2012 قام بنشر ديسمبر 5, 2012 (معدل) السلام عليكم جربي هكذا عله يفي بالغرض '************************************************* Public Nm_Work As String ' هنا تحددي مسار ملف المبيعات Private Const Path_A As String = "D:\المبيعات\فواتير\" ' هنا تحددي مسار ملف المدفوعات 'انشئي مجلد بأسم ' مدفوعات الموردين Private Const Path_A1 As String = "D:\المبيعات\فواتير\مدفوعات الموردين\" ' هنا تحددي مسار ملف المقبوضات 'انشئي مجلد بأسم ' مقبوضات العملاء Private Const Path_A2 As String = "D:\المبيعات\فواتير\مقبوضات العملاء\" '************************************************* Public Sub Ali_Sale() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم Nm_Work = " مبيعات" save_file Path_A, [I5], Nm_Work End Sub Public Sub Ali_Payment() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم Nm_Work = " مدفوعات" save_file Path_A1, [I5], Nm_Work End Sub Public Sub Ali_Proceed() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم Nm_Work = " مقبوضات" save_file Path_A2, [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 فاتورة_A.rar تم تعديل ديسمبر 6, 2012 بواسطه عباد
سالي قام بنشر ديسمبر 5, 2012 الكاتب قام بنشر ديسمبر 5, 2012 الله يبارك فيك استاذ ابو نصار الله يجازيك عني خيرا اكثر من رائع وان شاء الله احاول اني اتابع اكواد الطباعة حتي اتمكن من التحكم في عدد نسخ الطبع لان هذا الكود يطبع نسخة واحدة If ActiveSheet.CheckBox1.Value = True Then Activewindow.SelectedSheets.PrintOut والله والله اعجز عن شكركم حفظكم الله
الـعيدروس قام بنشر ديسمبر 6, 2012 قام بنشر ديسمبر 6, 2012 (معدل) الظاهر أنك حملتي المرفق وقت كنت اعدل لهذا الغرض سبحان الله ارجو منك تنزيل المرفق مره اخرى تم تعديل ديسمبر 6, 2012 بواسطه عباد
سالي قام بنشر ديسمبر 6, 2012 الكاتب قام بنشر ديسمبر 6, 2012 (معدل) انا اسفة اني علقت علي الطبع والله ما قصدي الا ان اخفف من طلباتي ممتاز جدا تسلم ايها الاستاذ العظيم والعظمة لله لكن ملاحظة صغيرة لدي نقل الكود الي برنامجي واسم المايكرو فيه هو ( طبع_فاتورة_المبيعات ) يظهر خطأ حتي بعد ان عدلت التالي 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 اتصور لازم اقوم بتعديل شيء حتي يعمل معي الله يبارك فيك يارب تم تعديل ديسمبر 6, 2012 بواسطه سالي
الـعيدروس قام بنشر ديسمبر 6, 2012 قام بنشر ديسمبر 6, 2012 الاكواد المرتبطه بالكود الاساسي هي ثلاثه هذا الكود يحدد لزر المبيعات Public Sub Ali_Sale() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم Nm_Work = " مبيعات" save_file Path_A, [I5], Nm_Work End Sub وهذا لزر المدفوعات Public Sub Ali_Payment() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم Nm_Work = " مدفوعات" save_file Path_A1, [I5], Nm_Work End Sub وهذا لزر المقبوضات Public Sub Ali_Proceed() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم Nm_Work = " مقبوضات" save_file Path_A2, [I5], Nm_Work End Sub وإن كان لكل واحد ملف فلابد من نسخ الاكود فرضا المبيعات بيكون كالتالي Public Nm_Work As String ' هنا تحددي مسار ملف المبيعات Private Const Path_A As String = "D:\المبيعات\فواتير\" Public Sub Ali_Sale() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم 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 وهكذا للمدفوعات Public Nm_Work As String Private Const Path_A1 As String = "D:\المبيعات\فواتير\مدفوعات الموردين\" Public Sub Ali_Payment() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم Nm_Work = " مدفوعات" save_file Path_A1, [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 وهكذا للمقبوضات Public Nm_Work As String Private Const Path_A2 As String = "D:\المبيعات\فواتير\مقبوضات العملاء\" Public Sub Ali_Proceed() ' 1 = مسار الملف المحدد أعلى الكود ' 2 = تحديد خلية التي بها رقم المستند ' 3 = حفظ الملف بأسم Nm_Work = " مقبوضات" save_file Path_A2, [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 1
سالي قام بنشر ديسمبر 6, 2012 الكاتب قام بنشر ديسمبر 6, 2012 الاستاذ الفاضل ابو نصار حفظكم الله ورعاكم وكثر من امثالكم علما وخلقا ونكرانا للذات حقيقي انا خجلانه من سمو خلقكم وتعبكم معي ابقاك الله ذخرا للمنتدي وزادك علما وايمانا تم المطلوب كاملا والحمد لله لكم ايها الاستاذ المبجل ومن خلالكم شكري الجزيل للاستاذ ابو حنين حيث ساعدتموني مساعدة لن انساها دمتم دائما بخير وبارك الله بكم مع خالص تقديري اختكم في الله سالي انور
الردود الموصى بها