كود طباعة عدد النسخ من خلية ذات ارقام متغيرة؟

[خالد علي خالد]

السلام عيكم اخوتي..واسف على الازعاج.

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

نموذج طباعة.xlsx

[محمد هشام.]

جرب هدا على ما اظن بعد تعيين حدود الطباعة بالشكل الدي يناسبك

Sub test()
ActiveSheet.PrintOut Copies:=ActiveSheet.Range("c10").Value, IgnorePrintAreas:=False
End Sub

 

[محمد هشام.]

بالرغم انني لا اعلم عن طريقة اشتغالك على الملف لاكن اليك طريقة اخرى ربما تفيدك 

الطريقة كالتالي

https://streamable.com/1kukv8

 

 

Public Property Get Sh_Print() As Worksheet: Set Sh_Print = Sheet1
End Property
Public Property Get Sh_Table() As Worksheet: Set Sh_Table = Sheet2
End Property

Sub To_print()
     TbPage = Sh_Table.[Tb_MiseEnPage]
     NbMax = UBound(TbPage)
    
     Cpt = Application.InputBox(Prompt:=" المرجوا ادخال رقم  الستيكر المرغوب طباعتها (من 0  الى " & NbMax & ")", Title:="طباعة", Type:=1)
     Cpt = Int(Cpt)
     If Cpt < 1 Then Exit Sub
If Cpt > NbMax Then:  MsgBox "اخر سكيرت على الملف هي :" & " " & NbMax, vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal, "تنبيه": Exit Sub
    
     With Sh_Print
    .PageSetup.PrintArea = ""
     For i = 1 To Cpt
          With .PageSetup
               .PrintArea = TbPage(i, 7) & ":" & TbPage(i, 8)
                Copies = TbPage(i, 6)
                If Copies < 1 Then Copies = 1
               .FitToPagesWide = 1
               .FitToPagesTall = 1
               
           End With
     Next
End With
    Sh_Print.PrintOut Copies:=Copies
End Sub

 

نموذج طباعة.xlsm

تم تعديل ديسمبر 3, 2023 بواسطه محمد هشام.

[محمد هشام.]

ادن جرب الكود التالي ربما يؤدي المطلوب 

 

 

Sub test()
Dim WS As Worksheet: Set WS = ActiveSheet
Dim pages As Integer
pages = WS.Range("C10")
  
  With WS
    .PageSetup.PrintArea = "$B$2:$D$7"
    .PrintOut Copies:=pages, Collate:=True
  End With
End Sub

 

نموذج طباعة 3.xlsm

[خالد علي خالد]

11 ساعات مضت, محمد هشام. said:

بالرغم انني لا اعلم عن طريقة اشتغالك على الملف لاكن اليك طريقة اخرى ربما تفيدك 

الطريقة كالتالي

https://streamable.com/1kukv8

 

 

Public Property Get Sh_Print() As Worksheet: Set Sh_Print = Sheet1
End Property
Public Property Get Sh_Table() As Worksheet: Set Sh_Table = Sheet2
End Property

Sub To_print()
     TbPage = Sh_Table.[Tb_MiseEnPage]
     NbMax = UBound(TbPage)
    
     Cpt = Application.InputBox(Prompt:=" المرجوا ادخال رقم  الستيكر المرغوب طباعتها (من 0  الى " & NbMax & ")", Title:="طباعة", Type:=1)
     Cpt = Int(Cpt)
     If Cpt < 1 Then Exit Sub
If Cpt > NbMax Then:  MsgBox "اخر سكيرت على الملف هي :" & " " & NbMax, vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal, "تنبيه": Exit Sub
    
     With Sh_Print
    .PageSetup.PrintArea = ""
     For i = 1 To Cpt
          With .PageSetup
               .PrintArea = TbPage(i, 7) & ":" & TbPage(i, 8)
                Copies = TbPage(i, 6)
                If Copies < 1 Then Copies = 1
               .FitToPagesWide = 1
               .FitToPagesTall = 1
               
           End With
     Next
End With
    Sh_Print.PrintOut Copies:=Copies
End Sub

 

نموذج طباعة.xlsm 28.17 kB · 3 downloads

 

15 ساعات مضت, محمد هشام. said:

جرب هدا على ما اظن بعد تعيين حدود الطباعة بالشكل الدي يناسبك

Sub test()
ActiveSheet.PrintOut Copies:=ActiveSheet.Range("c10").Value, IgnorePrintAreas:=False
End Sub

 

سلمك الله اخي الكريم.. الكود يعمل بكفاءة ما شاء الله.. المشكلة كانت في جهازي..في جهاز الشغل شغال زي الفل 🤩

شاكر لك وفقك الله في الدارين 🤲