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

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


إذهب إلى أفضل إجابة 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
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information