اذهب الي المحتوي
أوفيسنا

انحاز و طباعة اللاصقات فرذي و كلي

seddiki_adz

بواسطه seddiki_adz
في منتدى الاكسيل Excel

 مشاركة
إذهب إلى أفضل إجابة Solved by حسين مامون,

الردود الموصى بها

حسين مامون

حسين مامون

قام بنشر
قام بنشر

بعد اذن الاستاذ محسن واتراء للموضوع

طباعة نمودج1 

Option Explicit

Sub printCART()
Dim WS As Worksheet: Set WS = Sheets("Feuil1")
Dim WS1 As Worksheet: Set WS1 = Sheets("نموج1")
Dim lr, x
Dim rng1, rng2: Set rng1 = WS1.Range("d2:f22"): Set rng2 = WS1.Range("j2:l22")
Dim C1, C2, C3, C4
Set C1 = WS1.Range("d2"): Set C2 = WS1.Range("d13")
Set C3 = WS1.Range("j2"): Set C4 = WS1.Range("j13")
Application.ScreenUpdating = False
lr = WS.Cells(Rows.Count, "b").End(xlUp).Row
rng1.ClearContents
rng2.ClearContents
If MsgBox("هل تريد طباعة المحتوى", vbInformation + vbYesNo) = vbYes Then
For x = 2 To lr
If C1 = "" Then
WS1.[d2] = WS.Cells(x, 2)
WS1.[d4] = WS.Cells(x, 3)
WS1.[d6] = WS.Cells(x, 4)
WS1.[d8] = WS.Cells(x, 5)
WS1.[d10] = WS.Cells(x, 6)
GoTo 1
End If
If C2 = "" Then
WS1.[d13] = WS.Cells(x, 2)
WS1.[d15] = WS.Cells(x, 3)
WS1.[d17] = WS.Cells(x, 4)
WS1.[d19] = WS.Cells(x, 5)
WS1.[d21] = WS.Cells(x, 6)
GoTo 1
End If
If C3 = "" Then
WS1.[j2] = WS.Cells(x, 2)
WS1.[j4] = WS.Cells(x, 3)
WS1.[j6] = WS.Cells(x, 4)
WS1.[j8] = WS.Cells(x, 5)
WS1.[j10] = WS.Cells(x, 6)
GoTo 1
End If
If C4 = "" Then
WS1.[j13] = WS.Cells(x, 2)
WS1.[j15] = WS.Cells(x, 3)
WS1.[j17] = WS.Cells(x, 4)
WS1.[j19] = WS.Cells(x, 5)
WS1.[j21] = WS.Cells(x, 6)
WS1.Range("a1:l24").PrintOut: rng1.ClearContents: rng2.ClearContents
GoTo 1
End If
1: Next x
If C1 > 0 Or C2 > 0 Or C3 > 0 Or C4 > 0 Then
WS1.Range("a1:l24").PrintOut
End If
End If
Application.ScreenUpdating = True

End Sub

 

طباعة اللاصقات1.xlsm

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept