تعديل على كود طباعة

[sabah20267]

السلام عليكم

كود من تصميم الاستاذ  - محمد صالح - تعديل على الكود بحيث يكون الطبع نسختين عند الضغط على زر طباعة

 

Sub RectangleRoundedCorners333_Click()
'On Error Resume Next
'Sheets("وصل").Range("A1:q16").ExportAsFixedFormat xlTypePDF, Filename:="e:\pdf\" & Sheets("استعلام").Range("d5").Value & Sheets("استعلام").Range("c4").Value, openafterpublish:=True
Dim sh As Worksheet
Dim R
Dim fil_name
Set sh = ThisWorkbook.Worksheets("جديد")
fil_name = sh.Range("d5") & " " & sh.Range("c4")
Set R = sh.Range("a1:q30")
If IsError(Application.Match(Range("c4"), Range("s:s"), 0)) Then
pp:
R.ExportAsFixedFormat Type:=xlTypePDF, Filename:="e:\pdf\" & "\" & fil_name & ".pdf"
sh.Range("a1:q30").PrintOut
lr = Sheets("المستودعات").Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print lr
For n = 2 To lr
sr2 = Sheets("جديد").Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print sr2
For m = 19 To sr2
If Sheets("المستودعات").Range("A" & n) = Sheets("جديد").Range("A" & m) Then
Sheets("المستودعات").Range("A" & n & ":R" & n).Interior.Color = 10213316
End If
Next m
Next n
Range("s" & Range("s" & Rows.Count).End(xlUp).Row + 1).Value = [c4]
Else
m = MsgBox("تمت الطباعة قبل ذلك" & Chr(1000) & "هل تريد الطباعة مرة أخرى", vbYesNo, "تنبيه")
If m = 6 Then GoTo pp
End If
End Sub

 

 

 

[أ / محمد صالح]

عليكم السلام

السطر الذي يقوم بالطباعة هو 

sh.Range("a1:q30").PrintOutt

نقوم بتغييره إلى

sh.Range("a1:q30").PrintOutt Copies:=2

بالتوفيق

[sabah20267]

السلام عليكم ..تمام .. تسلم

 

 

 

[أ / محمد صالح]

سلمكم الله من كل سوء