محمد صبحى عبدالنعيم قام بنشر فبراير 20, 2016 قام بنشر فبراير 20, 2016 السلام عليكم ورحمة الله الاخوة الاعزاء السلام عليكم ورحمة الله الاخوة الاعزاء الرجاء المساعدة فى دمج كودين الكود الاول . هو كود ترحيل خلايا فى صف الى شيت اخر فى حدث دبل كليك على اسم الموظف ( الكود طبعا من منتداكم الرائع من موضوع تقرير منفصل لكل موظف ) الكود الثانى . هو كود فورم التنقل بين صفحات المصنف تظهر فى حدث رايت كليك على اسم الموظف (الكود طبعا من منتداكم الرائع من موضوع كود التنقل الى اي صفحة في ملف اكسيل ) المطلوب هو دمج الكودين بحيث عندما يضغط المستخدم رايت كليك على اسم الموظف تظهر فورم التنقل ويختار اى شيت يتم نقل بيانات الموظف الى هذا الشيت ولكم جزيل الشكر مرفق الملف للتعديل Book1.rar
ياسر خليل أبو البراء قام بنشر فبراير 20, 2016 قام بنشر فبراير 20, 2016 أخي الكريم يرجى تغيير اسم الظهور للغة العربية بدون الإطلاع على المرفق إليك فكرة قد تفيدك .. قم بعمل إجراء فرعي منفصل واستدعي كلاً من الكودين بالتتالي .. Call Macro1 Call Macro2 حيث Macro1 اسم الإجراء الأول المراد تنفيذه أولاً و Macro2 اسم الإجراء الفرعي الثاني المراد تنفيذه بعد الأول .. إذا لم يكن المطلوب فيرجى توضيح المطلوب وما هو الهدف من الكود بالضبط ليساعدك الأخوة الأعضاء تقبل تحياتي
محمد صبحى عبدالنعيم قام بنشر فبراير 20, 2016 الكاتب قام بنشر فبراير 20, 2016 8 ساعات مضت, ياسر خليل أبو البراء said: أخي الكريم اخى العزيز اشكر لك سرعه الرد يرجى تغيير اسم الظهور للغة العربية حاولت ذلك ولم اتمكن من ذلك وهل المقصود باسم الظهور هو الاسم الذى اسجل به الدخول للمنتدى ؟ بدون الإطلاع على المرفق إليك فكرة قد تفيدك .. اسفت كثرا لهذه الجملة ( بدون الاطلاع ) قم بعمل إجراء فرعي منفصل واستدعي كلاً من الكودين بالتتالي .. لا أريد استدعاء الكودين بالتتالى ما اريدة هو دمج الكودين ليصبحوا كود واحد ؟ Call Macro1 Call Macro2 حيث Macro1 اسم الإجراء الأول المراد تنفيذه أولاً و Macro2 اسم الإجراء الفرعي الثاني المراد تنفيذه بعد الأول .. إذا لم يكن المطلوب فيرجى توضيح المطلوب وما هو الهدف من الكود بالضبط ليساعدك الأخوة الأعضاء المطلوب هو دمج الكودين ليكونا كود واحد بحيث عندما يضغط المستخدم رايت كليك على اسم الموظف تظهر فورم التنقل ويختار اى شيت( تقرير ) يتم نقل بيانات الموظف الى هذا الشيت (التقرير) ليتم طباعتة تقبل تحياتي اشكر لك حسن المتابعة تقبل احترامى وتقديرى
ياسر خليل أبو البراء قام بنشر فبراير 20, 2016 قام بنشر فبراير 20, 2016 أعتذر إليك أخي إذا كانت جملة "بدون الإطلاع على المرفق" قد أزعجتك .. ولكن هل تعلم إذا كان لدي وقت لأقوم بالإطلاع بالتفصيل على كل الموضوعات التي تطرح بالمنتدى أم لا .. أحببت أن أجعل الموضوع نشط غير خامل فاقترحت فكرة ربما تفيدك .. أو ربما تكون الفكرة مفتاح للحل يمكن أن يقدمه شخص آخر عموماً أعتذر على تطفلي بالموضوع تقبل تحياتي
محمد صبحى عبدالنعيم قام بنشر فبراير 20, 2016 الكاتب قام بنشر فبراير 20, 2016 بل اعتذر انا اخى الفاضل ومعلمنا ابو البراء اعلم ان الجميع بمن فيهم انا لديه مايشغلة من امور الحياه والعمل ؟ وسعدت كثيرا عندما وجدت اول رد على موضوعى منك اخى ابو البراء ؟ وطمعت ان اجد ضالتى فى موضوعى من احد الاخوة الافاضل بالمنتدى الكريم ؟ لانى مبتداء و قليل الخبرة فى التعامل مع الاكسيل , هذان هما الكودان المراد دمجهما Option Explicit ---------------------------------------------------------------------------------------------- 'الكود الاول لنقل بيانات الموظف Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Column = 3 And Target.Row > 1 Then Application.ScreenUpdating = False Application.EnableEvents = False Cancel = True Dim Sh As Worksheet, lRow As Long Set Sh = Sheets("التقرير") lRow = Target.Row With Sh .Range("B3,C3,D3,E3,F3,G3").Value = "" .Range("H3,I3,J3,K3,L3").Value = "" If Not IsEmpty(Target) Then .Range("A3").Value = Date .Range("B3").Value = Cells(lRow, "B").Value .Range("C3").Value = Cells(lRow, "C").Value .Range("E3").Value = Cells(lRow, "D").Value .Range("F3").Value = Cells(lRow, "F").Value .Range("G3").Value = Cells(lRow, "H").Value .Range("H3").Value = Cells(lRow, "N").Value .Range("I3").Value = Cells(lRow, "T").Value .Range("J3").Value = Cells(lRow, "U").Value .Range("K3").Value = Cells(lRow, "V").Value .Range("L3").Value = Cells(lRow, "X").Value .Range("M3").Value = Cells(lRow, "Y").Value .Range("N3").Value = Cells(lRow, "Z").Value .Range("O3").Value = Cells(lRow, "AA").Value .Range("P3").Value = Cells(lRow, "AB").Value .Activate MsgBox "تم اعداد تقرير للموظف " & Cells(lRow, "C").Value & " Ýí æÑÞÉ ÇáÊÞÑíÑ", 64 End If End With Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub ---------------------------------------------------------------------------------------------- 'الكود الثانى لنقل الى ورقه التقرير المرادة Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Application.CommandBars("Workbook Tabs").ShowPopup End Sub انتظر المساعدة ولكم جزيل الشكر والتقدير
ياسر خليل أبو البراء قام بنشر فبراير 20, 2016 قام بنشر فبراير 20, 2016 هل اطلعت على مشاركة الأخ الفاضل محمد لطفي لعله يكون المطلوب ..التي تسبق مشاركتك الأخيرة مباشرةً؟ إذا لم يكن المطلوب ..دعك من الأكواد الموجودة واشرح بالتفصيل تخيلك للمطلوب ..حتى يتمكن الأخوة الأعضاء بتقديم المساعدة تقبل تحياتي
محمد صبحى عبدالنعيم قام بنشر فبراير 20, 2016 الكاتب قام بنشر فبراير 20, 2016 (معدل) نعم استاذى العزيز ابو البراء وكنت اكتب ردا لك اخى الفاضل اشكرك اخى العزيز محمد لطفى على محاولتك ولكنها لاتعمل بالشكل المطلوب ينقصها ان تنقل بيانات الموظف للصفحه المختارة فى تنقل البيانات لصفحه التقرير فقط المطلوب هو عند الضغط رايت كليك على اسم الموظف يتم نسخ بيانات الموظف الى اى صفحه يختارها المستخدم الملف عباره عن قاعده بيانات للموظفين و المستخدم هنا هو قسم التجنيد يقوم بمتابعه موقف الموظفين من التجنيد فعند انتهاء تاريخ الشهاده يطبع للموظف نموذج ايقاف عن العمل وعند احضارة للشهاده يطبع نموذج تمكينه من العمل واذا دخل الموظف لاداء الخدمة العسكرية يطبع له نموذج حفظ وظيفه واذا ادى الخدمه يطبع له اذن اعادة فكل هذه تقارير مرتبطه بالموظف الواحد فاريد عند الضغط على اسم الموظف ان تظهر لى فورم الانتقال الى اى تقريروعند اختيار اى شيت منهم يتم نسخ بيانات الموظف فيها ؟ اسف على الاطالة انتظر المساعده ولكم جزيل الشكر تم تعديل فبراير 20, 2016 بواسطه anywaysa
ياسر خليل أبو البراء قام بنشر فبراير 24, 2016 قام بنشر فبراير 24, 2016 أخي الكريم يرجى الإطلاع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى لمعرفة كيفية تغيير اسم الظهور (فضلاً لا أمراً) لقد نسيت موضوعك لعدم متابعتك له .. لدي أفكار ولكن غير مكتملة بعد .. لي سؤال : هل هناك ورقة عمل أساسية لنقل البيانات إليها أو ورقة عمل أساسية لنقل البيانات منها أم أن التعامل سيكون مع أي ورقة عمل للنقل منها أو النقل إليها ؟ حاول توضح طلبك بشكل آخر ..الغي الأكواد الموجودة في ملفك وضع تصورك للمطلوب .. كأن الموضوع جديد ..لأن الأكواد بهذا الشكل لن تؤدي المطلوب بالنسبة إليك .. ويا ريت تضرب مثال أو مثالين ..يعني مثلاً لو أنا في ورقة كذا وعملت كليك يمين في الخلية كذا واخترت الورقة كذا هيحصل كذا ..اضرب مثالين او ثلاثة لتتضح الصورة أكثر تقبل تحياتي
ياسر خليل أبو البراء قام بنشر فبراير 24, 2016 قام بنشر فبراير 24, 2016 أخي الكريم ضع الكود التالي في حدث ورقة العمل taqrers Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 3 And Target.Row > 1 Then Cancel = True UserForm1.Show End If End Sub يقوم الكود باستدعاء فورم .. ومن خلال الفورم يمكنك اختيار أوراق العمل التي تريد نقل البيانات إليها أنشيء فورم وضع عليه ListBox1 و CommandButton1 .. ثم ضع الكود التالي في حدث الفورم Private Sub UserForm_Initialize() Dim WS As Worksheet Dim I As Integer Dim iPos As Integer Me.ListBox1.MultiSelect = fmMultiSelectMulti For Each WS In ThisWorkbook.Worksheets If Not WS.Name = ActiveSheet.Name Then Me.ListBox1.AddItem WS.Name End If Next WS End Sub Private Sub CommandButton1_Click() Dim I As Integer, Sh As Worksheet, lRow As Long With Me.ListBox1 If .ListIndex <> -1 Then For I = 0 To .ListCount - 1 If .Selected(I) Then Set Sh = Sheets(.List(I)) With Sh If Not IsEmpty(ActiveCell) Then lRow = ActiveCell.Row .Range("A3").Value = Date .Range("B3").Value = ActiveSheet.Cells(lRow, "B").Value .Range("C3").Value = ActiveSheet.Cells(lRow, "C").Value .Range("D3").Value = ActiveSheet.Cells(lRow, "D").Value .Range("F3").Value = ActiveSheet.Cells(lRow, "F").Value .Range("G3").Value = ActiveSheet.Cells(lRow, "H").Value .Range("H3").Value = ActiveSheet.Cells(lRow, "N").Value .Range("I3").Value = ActiveSheet.Cells(lRow, "T").Value .Range("J3").Value = ActiveSheet.Cells(lRow, "U").Value .Range("K3").Value = ActiveSheet.Cells(lRow, "V").Value .Range("L3").Value = ActiveSheet.Cells(lRow, "X").Value .Range("M3").Value = ActiveSheet.Cells(lRow, "Y").Value .Range("N3").Value = ActiveSheet.Cells(lRow, "Z").Value .Range("O3").Value = ActiveSheet.Cells(lRow, "AA").Value .Range("P3").Value = ActiveSheet.Cells(lRow, "AB").Value MsgBox "تم إعداد تقرير للموظف " & ActiveSheet.Cells(lRow, "C").Value & " في ورقة " & .Name, 64 End If End With End If Next I End If End With End Sub أرجو أن يكون المطلوب . يمكنك التعديل في أسطر الترحيل بما يتناسب مع ملفك .. يمكنك اختيار أكثر من ورقة عمل للترحيل إليها وذلك من خلال اختيار أوراق العمل من الـ ListBox تقبل تحياتي Determine Destination Sheet On UserForm Using Worksheet Before Right Click YasserKhalil.rar
محمد صبحى عبدالنعيم قام بنشر فبراير 24, 2016 الكاتب قام بنشر فبراير 24, 2016 استذى المبدع دائما ياسر خليل أبو البراء اشكرلك سعت صدرك وصبرك الجميل لكم اتمنى ان اصل الى جزء من عقلك المبدع معك كل الحق لقد قمت بما اصبو اليه انا فى ملف الاكسيل المطلوب التعديل عليه ولاكنى اطمع فى ان يكون بنفس محطياته اى الفورم الجميل الذى يستخدمه معلمنا الكبير استاذنا عبدالله بوقشير وكانت هناك محاولات منى للتعديل على الملف ليجعل حدث نقل البيانات يحدث مع الانتقال الى الصفحه المختارة ولاكن معلوماتى المتدنيه بالفجوال بيسك لم تتخطى عقبه هذا الكود لانه هو يحدد الشيت المختار لنقل البيانات Set Sh = Sheets("التقرير") اشكرك استاذى الفاضل ادعوا الله العلى القدير ان يزيدك من علمه وينعم عليك بالصحه والعافيه تقبل منى فائق الاحترام والتقدير
ياسر خليل أبو البراء قام بنشر فبراير 25, 2016 قام بنشر فبراير 25, 2016 أخي الكريم محمد صبحي الحمد لله أن تم المطلوب على خير .. ومشكور على تغيير اسم الظهور للغة العربية جزيت خيراً على دعائك الطيب .. وفقني الله وإياكم لكل خير تقبل تحياتي
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.