أبو سجده

أخى الفاضل الاستاذ القدير // بن علية حاجى أخى الفاضل الاستاذ القدير // سليم حاصبيا السلام عليكم ورحمته الله وبركاته المرفق التالى يوضح مزيدا من تعديل النطاق del_range المرجو تحقيقه حيث أن النطاق هنا متعير وليس ثابتا بالموديول رقم 3 كود الـــ PRINT_ALL أضفت الكود الخاص بسيادتكم مرة والكود الخاص بالاستاذ الفاضل // سليم حاصبيا وكلاهما أدى الغرض ولكن أريد هنا بعد إذن حضراتكم تعين نطاق الــ del_range ليشمل الصغوف من F8 الى J37 بالاضافة الى النطاق من A38 الى J 44 حيث يشمل هذا النطاق جملة الكشف الاول + " تذييل الفاتورة " يتم نسخة من الورقة " data " علما بأن الفاتورة بنظام القرش والجنيه مع نظام تلحيق اجمالى الفاتورة ولكل 30 صنف برجاء الضغط على مفتاح F2 المطلوب بحول الله تعالى عدم إظهار النطاقات المذكورة مع طباعة النسخة الاولى وإظهارها مرة أخرى مع طباعة النسخة الثانية والثالثة وافر تقديرى واحترامى وجزاكم الله تعالى عنى خير الجزاء فاتورة مبيعات بنظام القرش والجنيه مع التفقيط.xlsb.rar

للرفع

اخى ونور عينى بن عليه حاجى بداية جزاكم الله خيرا ورزقنا وإياكم من حيث لانحتسب جارى تجربة طباعة المرفق وجزاكم الله خيرا

الاستاذ الفاضل // سليم حاصبيا السلام عليكم ورحمته الله بداية جزاكم الله خيرا وبارك فيكم بتجربة طباعة المرفق *** أعطيت أمر طباعة بعدد 3 نسخ وتبين الاتى إخفاء التفقيط وسعر الوحدة من جميع النسخ المطلوب بعد إذن حضرتك إخفاء التفقيط وسعر الوحدة واجمالى السعر واجمالى الفاتورة بالنسخة الاولى فقط على أن يتم إظهارهم بداية من النسخة الثانية ***** ولسيادتكم وافر تقديرى واحترامى وجزاكم الله خيرا

السلام عليكم ورحمته الله وبركاته بداية جزاكم الله خيرا وبارك فيكم جميعا من المعلوم إخوانى الافاضل عند طباعة الفاتورة نقوم بطباعة أصل + صورتين إذن عدد النسخ هنا ثلاثة نسخ فكيف يمكن إعطاء امر برمجى بكود لطباعة النسخة الاولى دائما دون قيم والتفقيط معا " عدم إظهار" فيما عدا ذلك يتم إظهار القيم بالتفقيط بالنسختين الثانية والثالثة جزاكم الله خيرا وبارك فيكم طباعة الفاتورة بشرط عدم إظهار سعر الوحدة واجماليات الفاتورة عند طباعة النسخة الاولى.rar

السلام عليكم بعد إذن إخوانى الافاضل الاستاذ القدير / ابو خليل والاستاذ القدير / احمد يعقوب والاستاذ القدير / ياسر العربى وبعد هذه الحلول الرائغة اسمحوا لى بهذة الاضافة على الاخ / ناصر ان يضع كود التنسيق لآخى القدير الحاج / احمد يعقوب فى بداية كود استدعاء البيانات ليتم استدعاؤها على النحو المطلوب ليصبح الكود هكذا Sub MACRO1() 'äÓÎ ÊäÓíÞ æÑÞÉ 2 Çáì ßá ÇæÑÇÞ ÇáãáÝ Dim RN1 As Range, SH, ER ' Sheets("æÑÞÉ2").Select Sheets("æÑÞÉ2").Range("A9:J9").Copy For SH = 2 To Sheets.Count ER = Sheets(SH).UsedRange.Rows.Count Set RN1 = Sheets(SH).Range("A8:J" & ER) RN1.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False RN1.PasteSpecial Paste:=xlPasteColumnWidths Next SH Application.CutCopyMode = False End Sub Sub test() Dim Col As New Collection, Arr, i As Long, J As Long On Error Resume Next Arr = Sheet1.Range("A7:J" & Sheet1.Cells(Rows.Count, "A").End(xlUp).Row).Value For i = 2 To UBound(Arr, 1) For J = 2 To UBound(Arr, 2) Col.Add Key:=J & Chr(2) & Arr(i, 1), Item:=Arr(i, J) Next J Next i With Sheet2.Range("A7:J" & Sheet2.Cells(Rows.Count, "A").End(xlUp).Row) Arr = .Value For i = 2 To UBound(Arr, 1) For J = 2 To UBound(Arr, 2) Arr(i, J) = Col(J & Chr(2) & Arr(i, 1)) Next J Next i .Value = Arr End With End Sub Sub Bring_Data() Dim i As Long Dim K As Long Dim LastRow As Integer Dim SourceSheet As Worksheet Set SourceSheet = ThisWorkbook.Sheets("sheet3") LastRow = SourceSheet.Range("e" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False Range("E7").Select K = 0 For i = 8 To LastRow + 8 Step 20 SourceSheet.Range("E" & i & ":V" & i + 19).Copy Range("A" & K + i).Select ActiveSheet.Paste K = K + 7 Next Application.ScreenUpdating = True End Sub Sub Clear_Data() Dim LastRow As Integer LastRow = Range("a" & Rows.Count).End(xlUp).Row Range("A8:V" & LastRow).Clear End Sub Sub Clear_Sheet2_Data() Dim LastRow As Integer LastRow = Sheet2.Range("a" & Rows.Count).End(xlUp).Row Sheet2.Range("B8:J" & LastRow).Clear End Sub Sub Call_All() Dim myConfirm myConfirm = MsgBox("åá ÊÑíÏ äÓÎ ÇáÊäÓíÞÇÊ", vbYesNo) If myConfirm = vbYes Then MACRO1 myConfirm = MsgBox("åá ÊÑíÏ ÇÓÊÏÚÇÁ ÇáÈíÇäÇÊ", vbYesNo) If myConfirm = vbYes Then test myConfirm = "" myConfirm = MsgBox(" åá ÊÑíÏ ÊÑÍíá ÇáÈíÇäÇÊ", vbYesNo) If myConfirm = vbYes Then Sheet5.Select Bring_Data Sheet2.Select End If myConfirm = "" myConfirm = MsgBox("åá ÊÑíÏ ãÓÍ ãÍÊæíÇÊ äØÇÞ ÇáÈíÇäÇÊ", vbYesNo) If myConfirm = vbYes Then Clear_Sheet2_Data myConfirm = "" myConfirm = MsgBox("åá ÊÑíÏ ÇáÈÏÁ Ýì äÞá ÇáÈíÇäÇÊ áØÈÇÚÉ ÇáßÔæÝ", vbYesNo) If myConfirm = vbYes Then StartTimer End Sub أرجو أن أكون قد وفقت فى تقديم مايصبوا اليه أخى الفاضل ناصر المصرى تقبلوا جميعا وافر احترامى وجزاكم الله خيرا

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

أخى وحبيب قلبى ابو البراء " حفظك الله " السلام عليكم ورحمته الله وبركاته أدرك انك لا تبخل على جميع السادة الاعضاء بما هو انت أهلا له أخى ابو البراء سأعيد رفع الموضوع مرة أخرى بحول الله تعالى ولكن بعد إستقرار حالتى الصحية حيث أحدثكم وأنا ملازم الفراش دعواتكم لى بالشفاء وجزاكم الله خيرا

وحياكم الله تعالى أخى الكريم رضا راغب لاتتردد فى أى طلب طالما أنه فى المستطاع وان لم يكن فجميع السادة الزملاء هنا يتمتعون بما من الله عليهم من علمه جزاكم الله خيرا وبارك الله فيكم

حبيب قلبى وأخى فى الله الاستاذ القدير // ياسر خليل " ابو البراء " السلام عليكم ورحمته الله وبركاته تسلم من كل شر وياريت متحرمناش من مساهماتك التى أخبرتك بها سالفا دون رد اعانكم الله تعالى ورزقنا واياكم من حيث لانحتسب جزاكم الله خيرا وبارك فى البراء

السلام عليكم جميعا ورحمته الله وبركاته أخى الفاضل الاستاذ // رضا راغب أهلا وسهلا بك أخى الكريم بين إخوانك المتميزين خلقا وعلما وأدبا وبعد إذن اخى الحبيب // ياسر خليل " أبو البراء " وإثراءا للموضوع إليك هذا الكود وبإذن الله تعالى ستجد حلا للموضوع جزاكم الله خيرا وبارك فيكم Private Const cRunWhat = "Tarhil_Values" Private RunWhen As Double, Arr() As Range, CurIndex As Long Public Sub StartTimer() Dim A As Areas, I As Long If RunWhen > 0 Then MsgBox "The Process Is Already Running" Exit Sub End If Set A = Sheets("Sheet1").Columns("A").SpecialCells(2, 1).Areas ReDim Arr(1 To A.Count) For I = 1 To A.Count Set Arr(I) = A(I).CurrentRegion Next I CurIndex = 0 RunWhen = Now + TimeSerial(0, 0, 10) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True End Sub Public Sub StopTimer() On Error Resume Next Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=False RunWhen = -1 MsgBox "Transferring Data Will Be Turned Off" End Sub Private Sub Tarhil_Values() CurIndex = CurIndex + 1 If CurIndex > UBound(Arr) Then StopTimer Exit Sub End If Arr(CurIndex).Copy Sheets("Sheet2").Cells(Arr(CurIndex).Row, "C") Application.CutCopyMode = False RunWhen = Now + TimeSerial(0, 0, 10) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True End Sub

للرفع

للرفع

السلام عليكم جميعا ورحمته الله وبركاته نظرا لاضافة عمود بورقة بيانات العاملين تم تعديل المرفق على النحو المطلوب بحول الله تعالى وافر تقديرى واحترامى ترحيل بيانات السادة العاملين بدلالة الرقم القومى - سعيد بيرم +11.rar

للرفع

للرفع

للرفع

للرفع

للرفع

للرفع

للرفع

للرفع

للرفع

الاح الفاضل // محمد شعبان السلام عليكم تم تحمبل المرفق وجارى قرأته فرأة جبدة وافر احترامى

للرفع