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

[Ahmed Saad 2017]

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

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

مرسل مثال بالفعل لفاتوره 1 و فاتوره 2 في شيت الفواتير المطبوعة

 

فاتورة_MH.xlsm

تم تعديل نوفمبر 29, 2022 بواسطه Ahmed Saad 2017

[وايلي حبيب]

مرفقل لك المطلوب

فاتورة_MH(1).xlsm

[Ahmed Saad 2017]

8 دقائق مضت, وايلي حبيب said:

مرفقل لك المطلوب

فاتورة_MH(1).xlsm 322.01 kB · 1 download

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

بشكرك مره تانيه علي المساعدة

[محمد هشام.]

تقصد انك تريد وضع الفواتير تحت بعض في شيت المطبوعات. او عند استدعاء فاتورة 2 مثلا نقوم بظغط على زر طباعة يتم انشاء الفاتورة بدون فراغات كما في الصورة

 لاكن مستقلة

تم تعديل نوفمبر 29, 2022 بواسطه Mohamed Hicham

[Ahmed Saad 2017]

33 دقائق مضت, Mohamed Hicham said:

تقصد انك تريد وضع الفواتير تحت بعض في شيت المطبوعات. او عند استدعاء فاتورة 2 مثلا نقوم بظغط على زر طباعة يتم انشاء الفاتورة بدون فراغات كما في الصورة

 لاكن مستقلة

تمام اقصد انه عند ترحيل الفاتوره يتم ترحيلها في صفحتين 

1- صفحة اليوميات -------- قد تم عمل الكود

2 - صفحة طباعة الفواتير -----------  اريد ان ترحل الفواتير تحت بعضها بدون فراغات ومثل الشيت المرسل 

[محمد هشام.]

اسف اخي على التاخير ودالك بسبب ظروف العمل

تفضل اخي لاكن ركز معي جيدا الفكرة انه تم تصميم نمودج للفاتورة في شيت مخفي  يتم نسخ البيانات من  الفاتورة اليه ثم اعادة نسخه  الى شيت المطبوعات لاجراء اللمسات الاخيرة .

يعني عند الرغبة في تعديل شكل الفاتورة لابد من التعديل على الاصل وهو شيت مخفي باسم  .(invoice)

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

اما بالنسبة لطلبك الاخير فقد تم تعديل كود الترحيل حيث يتم ترحيل البيانات الى شيت اليومية مع نسخ الفواتير تلقائيا  في شيت المطبوعات تحت بعض بدون فراغات . وبنفس الفكرة

اسف على الاطالة لاكن للتوضيح فقط .

اليك الاكواد

Sub invoice_printer2()
'هدا الكود لانشاء ورقة جديدة ونسخ الفاتورة
Dim ws As Worksheet
Dim r As Range
Dim MH As Long, MH1 As Long
Dim rng As Range
Dim i As Integer, counter As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Sheet In ActiveWorkbook.Worksheets
     If Sheet.Name = "الفاتورة" Then
          Sheet.delete
     End If
Next Sheet

Worksheets("invoice").Visible = True
Worksheets("invoice").Copy after:=Worksheets("invoice")
    ActiveSheet.Name = "الفاتورة"
    
  With ActiveSheet
     MH1 = .Cells(.Rows.Count, "E").End(xlUp).Row - 1
End With
Range("b7:E" & MH1).ClearContents
Range("c1:c5").ClearContents
 
  Set ws = Sheets("الفاتورة")
        Sheet1.Activate
            MH = Range("C" & Rows.Count).End(3).Row
                  
  Range("F9:F" & MH).Copy ws.Range("B7")
   Range("C9:C" & MH).Copy ws.Range("C7")
    Range("D9:D" & MH).Copy ws.Range("D7")
     Range("G9:G" & MH).Copy ws.Range("E7")
      ws.Range("C2").Value = Range("B3").Value
       ws.Range("C4").Value = Range("B5").Value
        ws.Range("C5").Value = Range("B6").Value
         ws.Range("C1").Value = Range("D6").Value
          ws.Range("c3").Value = Range("F5").Value
        
    
     Set rng = ws.Range("E7:E30")
     i = 1
     For counter = 1 To rng.Rows.Count
            If rng.Cells(i) = "" Then
                rng.Cells(i).EntireRow.delete
            Else
                i = i + 1
            End If
     Next
     
  Worksheets("invoice").Visible = False
   Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     Sheets("الفاتورة").Activate

 الكود الثاني والمهم

Sub invoice_printer()
'ترحيل الفواتير لشيت المطبوعات تلقائيا عند كل ترحيل
Dim ws As Worksheet
Dim r As Range
Dim MH As Long, MH1 As Long
Dim rng As Range
Dim i As Integer, counter As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets("invoice").Visible = True

Set ws = Sheets("invoice")
        Sheet1.Activate
            MH = Range("C" & Rows.Count).End(3).Row
           
  Range("F9:F" & MH).Copy ws.Range("B7")
   Range("C9:C" & MH).Copy ws.Range("C7")
    Range("D9:D" & MH).Copy ws.Range("D7")
     Range("G9:G" & MH).Copy ws.Range("E7")
      ws.Range("C2").Value = Range("B3").Value
       ws.Range("C4").Value = Range("B5").Value
        ws.Range("C5").Value = Range("B6").Value
         ws.Range("C1").Value = Range("D6").Value
          ws.Range("c3").Value = Range("F5").Value

derlig = Sheets("الفواتير المطبوعة").Range("a" & Rows.Count).End(xlUp).Row + 1
Worksheets("invoice").Range("A1:E30").Copy Worksheets("الفواتير المطبوعة").Range("a" & derlig)
 Sheet8.Activate
 MH2 = ActiveSheet.Range("C" & Rows.Count).End(3).Row
  For Each c In Range("A1:A5")
        If c = "" Then c.EntireRow.delete
    Next
    Set rng = Sheets("الفواتير المطبوعة").Range("c7:c" & MH2)
     i = 1
     For counter = 1 To rng.Rows.Count
            If rng.Cells(i) = "" Then
                rng.Cells(i).EntireRow.delete
            Else
                i = i + 1
            End If
    Next
    
Sheet7.Activate
With ActiveSheet
  MH1 = .Cells(.Rows.Count, "E").End(xlUp).Row - 1
End With
Range("b7:E" & MH1).ClearContents
Range("c1:c5").ClearContents
  Worksheets("invoice").Visible = False
   Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     Sheets("مستند قيد").Activate
   
   
 
End Sub

بالتوفيق

فاتورة_Mh3 - .xlsm

[Ahmed Saad 2017]

@Mohamed Hicham

بشكرك جزيلا علي مجهودك و انا اللي بتأسف لحضرتك علي تعبك و وقتك الثمين 

انا إن شاء الله تعالى هجرب الكود بكره إن شاء الله و اراجع حضرتك بعد التجربه

[Ahmed Saad 2017]

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

تم تعديل نوفمبر 30, 2022 بواسطه Ahmed Saad 2017

[محمد هشام.]

تفضل اخي تمت اضافة صف بين كل فاتورة

فاتورة_Mh4 - .xlsm

[Ahmed Saad 2017]

شكرا لحضرتك هجرب غدا ان شاء الله تعالى 

كده بتبقي لنا عمل يوزر فورم لادخال البيانات الخاصه بالفاتوره 

وانا عامل يوزر فورم الاصناف و ادخلها بتبقي باقي البيانات 

[محمد هشام.]

قم بتصميم  userform  كما تشاء وسوف نحاول  ننفذ المطلوب باذن الله تعالى. 

تفضل اخي تم اضافة كود لافراغ شيت المطبوعات

ضروري سوف تحتاجه في آخر اليوم بعد الإنتهاء من طباعة الفواتير 

فاتورة_Mh4 - .xlsm

تم تعديل نوفمبر 30, 2022 بواسطه Mohamed Hicham