اذهب الي المحتوي
أوفيسنا

المساعدة فى دمج كودين


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

 

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

الاخوة الاعزاء

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

الاخوة الاعزاء الرجاء المساعدة فى دمج كودين

الكود الاول . هو كود ترحيل خلايا فى صف الى شيت اخر فى حدث دبل كليك على اسم الموظف

( الكود طبعا من منتداكم الرائع من موضوع تقرير منفصل لكل موظف )

الكود الثانى . هو كود فورم التنقل بين صفحات المصنف تظهر فى حدث رايت كليك على اسم الموظف

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

المطلوب هو دمج الكودين بحيث عندما يضغط المستخدم

رايت كليك على اسم الموظف تظهر فورم التنقل ويختار اى شيت يتم نقل بيانات الموظف الى هذا الشيت

ولكم جزيل الشكر

 

مرفق الملف للتعديل

Book1.rar

رابط هذا التعليق
شارك

أخي الكريم

يرجى تغيير اسم الظهور للغة العربية

 

بدون الإطلاع على المرفق إليك فكرة قد تفيدك ..

قم بعمل إجراء فرعي منفصل واستدعي كلاً من الكودين بالتتالي ..

Call Macro1

Call Macro2

حيث Macro1 اسم الإجراء الأول المراد تنفيذه أولاً و Macro2 اسم الإجراء الفرعي الثاني المراد تنفيذه بعد الأول ..

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

تقبل تحياتي

رابط هذا التعليق
شارك

8 ساعات مضت, ياسر خليل أبو البراء said:

أخي الكريم

اخى العزيز

اشكر لك سرعه الرد

يرجى تغيير اسم الظهور للغة العربية

حاولت ذلك ولم اتمكن من ذلك وهل المقصود باسم الظهور هو الاسم الذى اسجل به الدخول للمنتدى ؟

بدون الإطلاع على المرفق إليك فكرة قد تفيدك ..

اسفت كثرا لهذه الجملة ( بدون الاطلاع )

قم بعمل إجراء فرعي منفصل واستدعي كلاً من الكودين بالتتالي ..

لا أريد استدعاء الكودين بالتتالى ما اريدة هو دمج الكودين ليصبحوا كود واحد ؟

Call Macro1

Call Macro2

حيث Macro1 اسم الإجراء الأول المراد تنفيذه أولاً و Macro2 اسم الإجراء الفرعي الثاني المراد تنفيذه بعد الأول ..

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

المطلوب هو دمج الكودين  ليكونا كود واحد بحيث عندما يضغط المستخدم  رايت كليك على اسم الموظف تظهر فورم التنقل ويختار اى شيت( تقرير ) يتم نقل بيانات الموظف الى هذا الشيت (التقرير) ليتم طباعتة

تقبل تحياتي

اشكر لك حسن المتابعة

تقبل احترامى وتقديرى

 

رابط هذا التعليق
شارك

أعتذر إليك أخي إذا كانت جملة "بدون الإطلاع على المرفق" قد أزعجتك ..

ولكن هل تعلم إذا كان لدي وقت لأقوم بالإطلاع بالتفصيل على كل الموضوعات التي تطرح بالمنتدى أم لا ..

أحببت أن أجعل الموضوع نشط غير خامل فاقترحت فكرة ربما تفيدك .. أو ربما تكون الفكرة مفتاح للحل يمكن أن يقدمه شخص آخر

عموماً أعتذر على تطفلي بالموضوع

تقبل تحياتي

 

رابط هذا التعليق
شارك

بل اعتذر انا اخى الفاضل ومعلمنا ابو البراء

اعلم ان الجميع بمن فيهم انا لديه مايشغلة من امور الحياه والعمل ؟

وسعدت كثيرا عندما وجدت اول  رد على موضوعى منك اخى ابو البراء ؟

وطمعت ان اجد ضالتى فى موضوعى من احد الاخوة الافاضل بالمنتدى الكريم ؟

لانى مبتداء و قليل الخبرة فى التعامل مع الاكسيل ,

هذان هما الكودان المراد دمجهما

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

انتظر المساعدة

ولكم جزيل الشكر والتقدير

رابط هذا التعليق
شارك

هل اطلعت على مشاركة الأخ الفاضل محمد لطفي لعله يكون المطلوب ..التي تسبق مشاركتك الأخيرة مباشرةً؟

 

إذا لم يكن المطلوب ..دعك من الأكواد الموجودة واشرح بالتفصيل تخيلك للمطلوب ..حتى يتمكن الأخوة الأعضاء بتقديم المساعدة

تقبل تحياتي

رابط هذا التعليق
شارك

نعم استاذى العزيز ابو البراء وكنت اكتب ردا لك اخى الفاضل

اشكرك اخى العزيز  محمد لطفى على  محاولتك ولكنها لاتعمل بالشكل المطلوب

ينقصها  ان تنقل بيانات الموظف للصفحه المختارة فى تنقل البيانات لصفحه التقرير فقط

المطلوب هو عند الضغط رايت كليك على اسم الموظف يتم نسخ بيانات الموظف الى اى صفحه يختارها المستخدم

الملف عباره عن قاعده بيانات للموظفين و المستخدم هنا هو قسم التجنيد يقوم بمتابعه موقف الموظفين من التجنيد

فعند انتهاء تاريخ الشهاده يطبع  للموظف نموذج ايقاف عن العمل وعند احضارة للشهاده يطبع نموذج تمكينه من العمل واذا دخل الموظف لاداء الخدمة العسكرية يطبع له نموذج حفظ وظيفه واذا ادى الخدمه يطبع له اذن اعادة

فكل هذه تقارير مرتبطه بالموظف الواحد فاريد عند الضغط على اسم الموظف ان تظهر لى فورم الانتقال الى اى تقريروعند اختيار اى شيت منهم يتم نسخ بيانات الموظف فيها ؟

اسف على الاطالة

انتظر المساعده ولكم جزيل الشكر

تم تعديل بواسطه anywaysa
رابط هذا التعليق
شارك

أخي الكريم يرجى الإطلاع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى لمعرفة كيفية تغيير اسم الظهور (فضلاً لا أمراً)

 

لقد نسيت موضوعك لعدم متابعتك له .. لدي أفكار ولكن غير مكتملة بعد ..

لي سؤال : هل هناك ورقة عمل أساسية لنقل البيانات إليها أو ورقة عمل أساسية لنقل البيانات منها أم أن التعامل سيكون مع أي ورقة عمل للنقل منها أو النقل إليها ؟

حاول توضح طلبك بشكل آخر ..الغي الأكواد الموجودة في ملفك وضع تصورك للمطلوب .. كأن الموضوع جديد ..لأن الأكواد بهذا الشكل لن تؤدي المطلوب بالنسبة إليك ..

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

تقبل تحياتي

رابط هذا التعليق
شارك

أخي الكريم

ضع الكود التالي في حدث ورقة العمل 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

رابط هذا التعليق
شارك

استذى المبدع دائما ياسر خليل أبو البراء

 

اشكرلك سعت صدرك وصبرك الجميل لكم اتمنى ان اصل الى جزء من عقلك المبدع

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

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

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

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

            Set Sh = Sheets("التقرير")

اشكرك استاذى الفاضل

ادعوا الله العلى القدير ان يزيدك من علمه وينعم عليك بالصحه والعافيه

تقبل منى فائق الاحترام والتقدير

رابط هذا التعليق
شارك

أخي الكريم محمد صبحي

الحمد لله أن تم المطلوب على خير .. ومشكور على تغيير اسم الظهور للغة العربية

جزيت خيراً على دعائك الطيب .. وفقني الله وإياكم لكل خير

تقبل تحياتي

رابط هذا التعليق
شارك

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