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

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

  • أفضل إجابة
قام بنشر

اهلا بك فى المنتدى هناك عدة أكواد يمكنها عمل ذلك , عليك بإختيار الأنسب لك

Public Sub PrintOneLine()
    Dim rng As Range
   
    For Each rng In Range(Range("A5"), Cells(Rows.Count, "A").End(xlUp))
        With rng.Parent
        .PageSetup.PrintArea = rng.EntireRow.Address
        '.PrintOut        'remove the apostrophy
        .PrintPreview  'Add an appostrophy
        End With
    Next rng
End Sub

وثانى كود

Sub PrintOneLine()
Dim Rng As Range
Dim WorkRng As Range
Dim xWs As Worksheet
On Error Resume Next
xTitleId = "Officena"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set xWs = WorkRng.Parent
For Each Rng In WorkRng
xWs.PageSetup.PrintArea = Rng.EntireRow.Address
xWs.PrintPreview
Next
End Sub

وهذا ثالث واخر كود

Sub Printseprete()
     Dim c As Range
     For Each c In ActiveSheet.Range("A5:A105")
     ActiveSheet.PageSetup.PrintArea = c.EntireRow.Address
     ActiveSheet.PrintOut
     Next c
    End Sub

 

Print.xlsm

  • Like 4

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