ميلان

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

وعليكم السلام اخي بن عليه حاجي شكرا لجهودك وأكرمك الله

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

السلام عليكم اصدقائي لدي ملف بسيط من شيت بيانات واخر نموذج طباعة مكون من ثمان فواتير مثل ماهو موضح في الصورة عند ادخال رقم واحد وضغط run يستحضر بيانات 8 مشتركين حسب الرقم الذي وضعه المطلوب هل استطيع عند الضغط رقم واحد واعضغط run ان يقوم بطابعة كل الفواتير تلقائيا من 1 الى نهاية المستند تلقائيا بدون ان احضر كل ثمان ارقام على حده وشكرا للجميع الكود كتبه استاذي الكريم سليم حاصيبا وفقه الله وزاده علما Option Explicit Dim s As Worksheet Dim T As Worksheet Dim last As Long, Ro% Dim s_rg As Range Dim i%, K%, My_ro1%, My_ro2%, My_ro% Dim m As Byte, n As Byte, xx As Byte '++++++++++++++++++++++++++++++++ Sub Fatura() Application.ScreenUpdating = False Set s = Sheets("Source") Set T = Sheets("Target") xx = 1 last = s.Cells(Rows.Count, 1).End(3).Row If Val(T.Range("J1")) <= 0 Then i = 1 Else i = Int(Abs(T.Range("J1"))) End If T.Range("J1") = i T.Range("Rg_ALL").ClearContents For K = i + 3 To i + 10 If K > last Then Exit For Select Case xx Mod 8 Case 1: m = 2: n = 2 Case 2: m = 2: n = 5 Case 3: m = 11: n = 2 Case 4: m = 11: n = 5 Case 5: m = 20: n = 2 Case 6: m = 20: n = 5 Case 7: m = 29: n = 2 Case 0: m = 29: n = 5 End Select s.Cells(K, 1).Resize(, 7).Copy T.Cells(m, n).PasteSpecial _ 12, Transpose:=True xx = xx + 1 Next Application.CutCopyMode = False Print_Area T.Cells(2, 1).Select Application.ScreenUpdating = True End Sub '+++++++++++++++++++++++++++++++++++ Sub Print_Area() Set T = Sheets("Target") Ro = T.Cells(Rows.Count, 1).End(3).Row For i = 2 To Ro - 6 Step 9 If T.Cells(i, 2) <> "" Then My_ro1 = i + 6 End If Next For i = 2 To Ro - 6 Step 9 If T.Cells(i, 5) <> "" Then My_ro2 = i + 6 End If Next My_ro = Application.Max(My_ro1, My_ro2) T.PageSetup.PrintArea = T.Range("A1:E" & My_ro).Address End Sub otokar.xlsm

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

استاذنا الكريم شكرا لمرورك الجميل واود ان اكرر شكري بأن الكود أعمل عليه وهوممتاز ولا يوجد اي خلل شكرا لك من القلب

السلام عليكم اصدقائي لدي كود قام بكتابته استاذنا الكبير سليم حاصيبا واعمل عليه وهو ممتاز الية الكود ترحيل البيانات من شيت لاخر وعند الضغط على زر طباعة يتغير لون صف العامود الذي اخترته الى لون ازرق كاشف والذي اصبح غير واضح لاني البس نظارات اريد تغيير اللون الى اصفر اساسي وشكرا للجميع الاخوة في هذا المنتدى الرائع الكود كالتالي في الشيت الاول والثاني : Option Explicit Dim S As Worksheet Dim T As Worksheet Dim last As Long, Ro% Dim s_rg As Range Dim i%, K%, My_ro1%, My_ro2%, My_ro% Dim M As Byte, n As Byte, xx As Byte '++++++++++++++++++++++++++++++++ Sub Fatura() Application.ScreenUpdating = False Set S = Sheets("Source") Set T = Sheets("Target") xx = 1 last = S.Cells(Rows.Count, 1).End(3).Row If Val(T.Range("J1")) <= 0 Then i = 1 Else i = Int(Abs(T.Range("J1"))) End If T.Range("J1") = i T.Range("Rg_ALL").ClearContents For K = i + 3 To i + 10 If K > last Then Exit For Select Case xx Mod 8 Case 1: M = 2: n = 2 Case 2: M = 2: n = 5 Case 3: M = 11: n = 2 Case 4: M = 11: n = 5 Case 5: M = 20: n = 2 Case 6: M = 20: n = 5 Case 7: M = 29: n = 2 Case 0: M = 29: n = 5 End Select S.Cells(K, 1).Resize(, 7).Copy T.Cells(M, n).PasteSpecial _ 12, Transpose:=True xx = xx + 1 Next Application.CutCopyMode = False Print_Area T.Cells(2, 1).Select Application.ScreenUpdating = True End Sub '+++++++++++++++++++++++++++++++++++ Sub Print_Area() Set T = Sheets("Target") Ro = T.Cells(Rows.Count, 1).End(3).Row For i = 2 To Ro - 6 Step 9 If T.Cells(i, 2) <> "" Then My_ro1 = i + 6 End If Next For i = 2 To Ro - 6 Step 9 If T.Cells(i, 5) <> "" Then My_ro2 = i + 6 End If Next My_ro = Application.Max(My_ro1, My_ro2) T.PageSetup.PrintArea = T.Range("A1:E" & My_ro).Address End Sub الشبيت الثاني Option Explicit Dim S As Worksheet Dim B As Worksheet Dim last%, i% Dim dic As Object Dim Mon_array Dim Itm Dim Nb% '++++++++++++++++++++++++++++++++ Sub Fatura_One() Set S = Sheets("Source") Set B = Sheets("By_one") Set dic = CreateObject("Scripting.Dictionary") last = S.Cells(Rows.Count, 1).End(3).Row S.Range("A4").Resize(last, 9).Interior.ColorIndex = xlNone For i = 4 To last If Not IsEmpty(S.Cells(i, 2)) Then S.Cells(i, 1).Resize(, 9).Interior.ColorIndex = 35 Mon_array = Application.Transpose _ (S.Cells(i, 1).Resize(, 9)) Mon_array = Join(Application.Transpose(Mon_array), "*") dic(dic.Count) = Mon_array End If Next If dic.Count Then For Each Itm In dic.Items() B.Range("E6").Resize(9) = _ Application.Transpose(Split(Itm, "*")) '========================== B.PrintPreview '======================== Next End If Set dic = Nothing End Sub '+++++++++++++++++++ Sub New_Month() Set S = Sheets("Source") last = S.Cells(Rows.Count, 1).End(3).Row S.Range("A4:I" & last).Interior.ColorIndex = xlNone S.Range("K4:K" & last) = vbNullString End Sub الشيت الاساسي جزاكم الله كل خير والملف في الاسفل OTOKAR 21.2.2021.xlsm

السلام عليكم اخواني في الله لدي هذه المشكلة تظهر عند الدخول الى قاعدة البيانات ولا اعلم مالحل ارجو منكم مساعدتي لاني بحاجة للملف اليوم الاسم RH كلمة السر 357 2.xlsb

شكرا جزيلا اخي الكريم لقد نفذ ما اقصد بالضبط ♥️♥️♥️♥️🙏 شكرا لجهودك وأكرمك الله فيما تعمل

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

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

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

السلام عليكم أصدقائي في محاولات مني ك مبتدئ حاولت كتابه كود تاريخ والوقت ضمن خليه في ورقة عمل مثل الصورة الموضحة لكن عند حفظه او الانتقال الى ورقة العمل لا تظهر البيانات ويعطيني هذا الخطأ فما المشكله #مبتدئ

جزاك الله كل خير استاذي الكريم لقد اوفيت الغرض شكرا لك ولجهودك استاذي @سليم حاصبيا

@سليم حاصبيا Bab Salam_New.xlsm

@سليم حاصبيا استاذنا الكبير اعلم اني قد تماديت في الطلب لكن بعد استعمال الكود تبين انه عند طباعه الفاتور يتغير لونها وعند طباعه فاتورة اخرى يعود لونها بدون تعبئة ولم استطع تمييز الفواتير المدفوعة المرجو انه عند طباعه فاتورة ان يتغير لونها ويبقى ثابت لتميزهم وسؤال اخر بعد انتهاء الشهر كيف اعيد الشت بدون تعبئة لاعيد استخدامه في الشهر القادم وجزاك الله كل خير واوسع علمك ومعرفتك وكل الاحترام

شكرا شكرا استاذي الكريم على مجهودك الرائع كل المحبة والاحترام لك جزاك الله خير الجزاء واوسع معرفتك ♥️♥️♥️♥️

@سليم حاصبيا انا حقا اسف استاذي الكريم ظننت اني اوصلت الفكرة الصحيحة اعتذر منك فعلا وشكرا لجهودك سبقا استاذي الكريم كل المحبة لك

@سليم حاصبيا استاذنا الكبير سليم حاصيبا كلمة شكر لا اتكفي بحقك كل الشكر والاحترام لك سلمت يداك فعلت المطلوب واكثر شكرا جزيلا لك اخي في الله واستاذي الكبير استاذنا الكبير @سليم حاصبيا هناك مشكلة لوتفضلت علي بالوقت عندما اضع رقم الفاتورة واضغط run يقوم بطابعة من رقم 1 والى نهاية الملف والمطلوب هو طباعه فقط الرقم الذي استدعيه وشكرا جزيلا لك

كل الشكر الى هذا المنتدى الرائع وخصيصا الى الاستاذ الكبير الرائع @سليم حاصبيا الذي ساعدني كثيرا في هذا الملف وأود التعديل عليه بعد تغيير في نظام العمل لدى المخيم وهذا العمل مجاني بالكامل ولوجه الله تعالى الملف الاستاذ سليم قد برمج الكود لاستدعاء 8 فواتير دفعه واحدة المطلوب الان 1 - تعديله ليصبح يستدعي فاتورة واحدة 2 -اضافة زر طباع كما هو موضح بالصورة 3 - عند طابعه فاتورة ان يتغير لون الصف بغير لون لتمييزه في الشيت الاساسي 4 - اضافة عامود في اول شيت باسم فاقد الشبكة لترحيل القيمة للفاتورة وكل الشكر لجميع الاصدقاء حاولت انا ولكن فشلت وفي طريق التعلم منكم اخوتي في الله كل الحب والاحترام مخيم باب السلام.xlsm

صديقي العزيز والغالي كم أنت جميل شكرا لك لم اقصد ان تتعب نفسك ولك جزيل الشكر والتقدير والاحترام على مجهودك في الغد ان شاء الله سأعمل على الملف واستعمله وسأخبرك كلمه شكر لا تكفيك أخي الكريم تحياتي لك 🌹🌹❤️❤️

استاذنا الكبير @سليم حاصبيا كل الشكر والتقدير والاحترام لك المنقذ الأول بعد الله سبحانه في كل المشاكل انا آسف معك الحق وأفعل في المره التاليه وشكرا لحلولك الرائعة ❤️ انا هنا اخي الكريم ولا أستطيع ان انسى استاذنا من الفضل والشكر ولو كان اكثر لفعلت تحياتي لك ❤️ شكرا اخي الكريم كل المحبه والاحترام والتقدير 💓

السلام عليكم اخوتي الكرام والشكر لكل المشرفين اما بعد لدي عوائل في مخيم على الحدود وبحاجة الى برنامج قيود مصغر يحتوي على بيانات كل عائلة وملفات منفلة ك معاقين وعوائل ايتام اذا كان هناك اي ما يشبه ما تكلمت عنه ارجو منكم مساعدتي في الوقت الحالي اعمل على اكسل لتخزين بياناتهم لكن البيناتات كثيرة نوعا ما فاذا كان هناك ما يشبه ارجو منكم مساعدتي ولكم جزيل الشكر في الاسفل تركت الملف الذي اعمل عليه لاجل فهم ما احتاج اليه السجل الكامل والصحيح للمخيم-DESKTOP-U85F05K.rar

السلام عليكم اخواني في هذا المنتدى لدي مشكلة بما انني مبتدأ لدي ملف اكسل لمخيم في سوريا يحتوي على بيانات العوائل والاطفال لكن المشكلة انه في اول عامور الرقم التنسلسي عند السحب للترقيم من جديد يعطيني لايمكن بسبب الخلايا المدمجة غير متساوية او متناسقة وانا مجبور على وضعها من اجل خانات الاطفال لكل عائلة ل يوجد حل للترقيم التلقائى للرقم التسلسلي مع وجود هذه الخلايا وجزاكم الله كل خير السجل الكامل والصحيح للمخيم-DESKTOP-U85F05K.rar

@محمد أبوعبدالله مثل هذه في زر طباعه الفاتورة