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

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

قام بنشر (معدل)

السلام عليكم

لو سمحتم فى الجدول المرفق لما اكتب فى خانة رقم الحساب وليكن مثلا رقم 7 بتظهر ليا النتائج الخاصة برقم الحساب 7

طلبي من السادة الافاضل كود يخلينى لما اطبع اطبع الصفحة الاولى فقط وليس باقى الصفحات

وشاكر لكم

طباعة.rar

تم تعديل بواسطه derbala
قام بنشر

السلام عليكم

جرب هذا الكود فرضا أن مدى البيانات من العمود A الى العمود C


Public Sub Ali_Page()

    Dim S			    As Long

    With ActiveSheet

    On Error Resume Next

    S = .HPageBreaks(1).Location.Row

    If S = 0 Then Exit Sub

    .ResetAllPageBreaks

    .PageSetup.PrintArea = ""

    .PrintTitleRows = "$1:$1"

    .PageSetup.PrintArea = .Range(.Cells(1, "A"), .Cells(S - 1, "C")).Address

    .PrintPreview

    End With

End Sub

قام بنشر

السلام عليكم و رحمة الله و بركاته

الاخ الفاضل

تفضل المرفق و ارجو من الله ان يكون هذا ما تريده

و الله المستعان

و السلام عليكم و رحمة الله و بركاته

السلام عليكم و رحمة الله و بركاته

الاخ الفاضل

تفضل المرفق و ارجو من الله ان يكون هذا ما تريده

و الله المستعان

و السلام عليكم و رحمة الله و بركاته

شكرا لسرعة ردك واهتمامك بالموضوع

ماشاء الله عليك الكود قريب من اللى انا عاوزة بس هوا بيغير فى الهيدر بتاع الصفحة

انا غلطت الاول فى شرح الموضوع

انا كان قصدى انى لما ابحث عن رقم الحساب رقم 7 هتظهر على صفحة ونص فمحتاج كود عشان اطبع الصفحة ونص بس

ولو فرضا ان النتائج على صفحتين اطبع الصفحتين وبس ولو كانت على صفحة اطبع صفحة بس وهكذا

ياريت لو حضرتك تساعدنى

شكرا

قام بنشر

السلام عليكم

جرب هذا الكود فرضا أن مدى البيانات من العمود A الى العمود C


Public Sub Ali_Page()

Dim S			 As Long

With ActiveSheet

On Error Resume Next

S = .HPageBreaks(1).Location.Row

If S = 0 Then Exit Sub

.ResetAllPageBreaks

.PageSetup.PrintArea = ""

.PrintTitleRows = "$1:$1"

.PageSetup.PrintArea = .Range(.Cells(1, "A"), .Cells(S - 1, "C")).Address

.PrintPreview

End With

End Sub

الف شكر لحضرتك يا استاذ ابو نصار

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

وشكرا للاهتمام وسرعة الرد

قام بنشر (معدل)

السلام عليكم

بعد اذن اخي الحبيب أحمد فضيله استبدل كود حدث الورقة بالتالي


Private Row_A As Integer

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 7 And Target.Column = 4 Then

On Error Resume Next

Dim A_r

With Sheet3

.Range("aa11:aa5555").AutoFilter Field:=1, Criteria1:="=" & .[k10]

If .AutoFilterMode = False Then

Row_A = .Range("E65536").End(xlUp).Offset(1, 0).Row

Else

With .AutoFilter.Range

		 Row_A = .Row + .Rows.Count

End With

End If

With .Range(.Cells(4, 2), .Cells(Row_A, 5))

	 .Select

	 A = .Address

End With

.ResetAllPageBreaks

.PageSetup.PrintArea = ""

.PageSetup.PrintTitleRows = "$4:$10"

.PageSetup.PrintArea = A

.Range("aa11:aa5555").Rows.AutoFit

.PrintPreview

End With

End If

End Sub

طباعة.xlsm_A.rar

تم تعديل بواسطه عباد
قام بنشر

السلام عليكم

اولا : احب ان اتقدم بجزيل الشكر والاحترام للاستاذ احمد فضيلة والاستاذ ابو نصار لما بزلوه من جهد فى سبيل مساعدتى

ثانيا : الملفات المرفقة من طرفكم هيا اللى كنت انا عاوزها وبدور عليها

ولقيت كود تانى وصلنى لنفس النتيجة لقيته فى هذا المنتدى الرائع فى موضوع

(موضوع مميز ) بعض الاكواد المنفصلة قد تهم البعض

مشاركة العضو Naderwatfa

واخيرا الف شكر على المساعدة من اعضاء هذا المنتدى الرائع

قام بنشر

السلام عليكم

بعد اذن اخي الحبيب أحمد فضيله استبدل كود حدث الورقة بالتالي


Private Row_A As Integer

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 7 And Target.Column = 4 Then

On Error Resume Next

Dim A_r

With Sheet3

.Range("aa11:aa5555").AutoFilter Field:=1, Criteria1:="=" & .[k10]

If .AutoFilterMode = False Then

Row_A = .Range("E65536").End(xlUp).Offset(1, 0).Row

Else

With .AutoFilter.Range

		 Row_A = .Row + .Rows.Count

End With

End If

With .Range(.Cells(4, 2), .Cells(Row_A, 5))

	 .Select

	 A = .Address

End With

.ResetAllPageBreaks

.PageSetup.PrintArea = ""

.PageSetup.PrintTitleRows = "$4:$10"

.PageSetup.PrintArea = A

.Range("aa11:aa5555").Rows.AutoFit

.PrintPreview

End With

End If

End Sub

اخي الحبيب / ابو نصار

جزاك الله كل خير وسلمت يمينك

قام بنشر

السلام عليكم

اولا : احب ان اتقدم بجزيل الشكر والاحترام للاستاذ احمد فضيلة والاستاذ ابو نصار لما بزلوه من جهد فى سبيل مساعدتى

ثانيا : الملفات المرفقة من طرفكم هيا اللى كنت انا عاوزها وبدور عليها

ولقيت كود تانى وصلنى لنفس النتيجة لقيته فى هذا المنتدى الرائع فى موضوع

(موضوع مميز ) بعض الاكواد المنفصلة قد تهم البعض

مشاركة العضو Naderwatfa

واخيرا الف شكر على المساعدة من اعضاء هذا المنتدى الرائع

الاخ الفاضل

عفوا يا اخي

اللهم علمنا ما ينفعنا و انفعنا بما علمتنا

و الله المستعان

و السلام عليكم و رحمة الله و بركاته

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