با سلام
لطفا فایل ضمیمه را بررسی نمایید
توضیح: هر دو دکمه پرینت کل و پرینت تکی اصلاح شد
برای پرینت تکی فقط کافیست آن ردیف را انتخاب کنید مهم نیست که در کدام خانه باشید فقط یک خانه درآن ردیف را انتخاب کنید.
کد:
Sub PrintM()
Dim Cell As Range
Dim Lastrow As Integer
If Sheet1.Range("D4") = "" Then
MsgBox "تعداد چاپ وارد نشده است "
Exit Sub
End If
On Error Resume Next
Lastrow = Sheet1.Cells(Rows.Count, "b").End(3).Row
For Each Cell In Sheet1.Range("B15:b" & Lastrow)
Sheet2.Range("K25") = Cell.Value
Sheet2.Range("K20") = Cell.Offset(0, 1).Value
Sheet2.Range("K14") = Cell.Offset(0, 2).Value
Sheet2.Range("K9") = Cell.Offset(0, 3).Value
Sheet2.Range("K8") = Cell.Offset(0, 4).Value
Sheet2.Range("K6") = Cell.Offset(0, 5).Value
Sheet2.Range("K1") = Cell.Offset(0, 7).Value
Sheet2.PrintOut Copies:=Sheet1.Range("D4"), Collate:=True, _
IgnorePrintAreas:=False
'Sheets("ورود اطلاعات").Select
Next
End Sub
Sub PrintRowM()
mm = Split(ActiveCell.Address, "$")(2)
Sheet2.Range("K25") = Sheet1.Range("B" & mm).Value
Sheet2.Range("K20") = Sheet1.Range("B" & mm).Offset(0, 1).Value
Sheet2.Range("K14") = Sheet1.Range("B" & mm).Offset(0, 2).Value
Sheet2.Range("K9") = Sheet1.Range("B" & mm).Offset(0, 3).Value
Sheet2.Range("K8") = Sheet1.Range("B" & mm).Offset(0, 4).Value
Sheet2.Range("K6") = Sheet1.Range("B" & mm).Offset(0, 5).Value
Sheet2.Range("K1") = Sheet1.Range("B" & mm).Offset(0, 7).Value
Sheet2.PrintOut Copies:=Sheet1.Range("D4"), Collate:=True, _
IgnorePrintAreas:=False
End Sub
موفق باشید میر
علاقه مندی ها (Bookmarks)