اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

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

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

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

رابط هذا التعليق
شارك

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

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

https://streamable.com/1kukv8

 

img?id=515683

 

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

تم تعديل بواسطه محمد هشام.
  • Like 2
رابط هذا التعليق
شارك

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

 

 

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

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

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

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

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

https://streamable.com/1kukv8

 

img?id=515683

 

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

 

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

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

  • 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