.:: طلب ربط ملفين ببعض وجلب البيانات عن طريق الرقم ::.

[مجدي الطيب]

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

 

لدي طلب أرجو انه يكون بسيط وسهل ع المحترفين اللي فـ المنتدى .. 
انا لدي نموذج إسمه " نموذج إستمرارية عمل " احتاج لتعبئته بإستمرار ولعدد كبير من الموظفين 

ولدي ملف آخر يحتوي على البيانات المطلوب تعبئتها بالنموذج

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

من ملف البيانات إلى النموذج وانا أقوم بطباعته مباشرة ويكون جاهز عـ الإعتماد فقط ؟!
أرجو الإفادة لو كان هذا ممكن .. ولكم جزيل الشكر .. 

مرفق ملفين ( ملف النموذج + ملف البيانات )

 

في الإنتظار ..   

Desktop.rar

[ياسر خليل أبو البراء]

أخي الكريم مجدي الطيب

جرب الكود التالي (قمت بتغيير اسم المصنف للغة الإنجليزية ..يمكنك تسميته باللغة العربية وتعديل الاسم في الكود ..فقط لسهولة التعامل مع الكود قمت بتغيير اسم المصنف )

Sub ImportData()
    Dim WB As Workbook, rngLookup As Range
    Dim myRow As Long
    Dim shMain As Worksheet
    
    Application.ScreenUpdating = False
    Set shMain = ThisWorkbook.ActiveSheet

    Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "Data Base.xlsx")
    Set rngLookup = WB.ActiveSheet.Range("B3:B" & WB.ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row)
    
    On Error Resume Next
    With shMain
        myRow = Application.WorksheetFunction.Match(.Range("B1"), rngLookup, 0) + 2
        Union(.Range("C8"), .Range("K8"), .Range("D11"), .Range("C14"), .Range("G14"), .Range("K14")).ClearContents
        .Range("C8") = WB.ActiveSheet.Cells(myRow, "C")
        .Range("K8") = WB.ActiveSheet.Cells(myRow, "E")
        .Range("D11") = WB.ActiveSheet.Cells(myRow, "D")
        .Range("C14") = WB.ActiveSheet.Cells(myRow, "F")
        .Range("G14") = WB.ActiveSheet.Cells(myRow, "G")
        .Range("K14") = WB.ActiveSheet.Cells(myRow, "H")
    End With
    
    WB.Close False
    Application.ScreenUpdating = True
End Sub

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

تقبل تحياتي

Import Data From Closed Workbook.rar

[مجدي الطيب]

أخي الكريم مجدي الطيب

جرب الكود التالي (قمت بتغيير اسم المصنف للغة الإنجليزية ..يمكنك تسميته باللغة العربية وتعديل الاسم في الكود ..فقط لسهولة التعامل مع الكود قمت بتغيير اسم المصنف )

Sub ImportData()
    Dim WB As Workbook, rngLookup As Range
    Dim myRow As Long
    Dim shMain As Worksheet
    
    Application.ScreenUpdating = False
    Set shMain = ThisWorkbook.ActiveSheet

    Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "Data Base.xlsx")
    Set rngLookup = WB.ActiveSheet.Range("B3:B" & WB.ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row)
    
    On Error Resume Next
    With shMain
        myRow = Application.WorksheetFunction.Match(.Range("B1"), rngLookup, 0) + 2
        Union(.Range("C8"), .Range("K8"), .Range("D11"), .Range("C14"), .Range("G14"), .Range("K14")).ClearContents
        .Range("C8") = WB.ActiveSheet.Cells(myRow, "C")
        .Range("K8") = WB.ActiveSheet.Cells(myRow, "E")
        .Range("D11") = WB.ActiveSheet.Cells(myRow, "D")
        .Range("C14") = WB.ActiveSheet.Cells(myRow, "F")
        .Range("G14") = WB.ActiveSheet.Cells(myRow, "G")
        .Range("K14") = WB.ActiveSheet.Cells(myRow, "H")
    End With
    
    WB.Close False
    Application.ScreenUpdating = True
End Sub

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

تقبل تحياتي

 

جزاك الله خيراً عـ الإهتمام وسرعة الرد .. بس ماني عارف وين المشكلة .. شوف شنو يطلعلي بالصورة المرفقة

هل عليا ان استعمل الكود في مكان ما من الملف .. او يكفي اني احمل الملف اللي انت أرفقته .. يكون جاهز للتعديل ؟   

تحياتي 

[ياسر خليل أبو البراء]

هل قمت بتغيير اسم المصنف الذي يتم جلب البيانات منه كما في الكود ...

شوف اسم المصنف عندك وعدل في الكود بالاسم في السطر

Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "Data Base.xlsx")

يعني شوف اسم المصنف ايه اللي إنت بتاخد منه البيانات وعدل هذا السطر بما يناسب اسم ملفك

[ا بو سليمان]

ما شاء الله تبارك الله  اخي  ياسر    دائما مثل الشمعة التي تحترق لتظيئ  الطريق

[ياسر خليل أبو البراء]

أخي وحبيبي أبو سليمان

مش ناوي تكون شمعة معايا عشان شمعتي قربت تنطفي

[مجدي الطيب]

هل قمت بتغيير اسم المصنف الذي يتم جلب البيانات منه كما في الكود ...

شوف اسم المصنف عندك وعدل في الكود بالاسم في السطر

Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "Data Base.xlsx")

يعني شوف اسم المصنف ايه اللي إنت بتاخد منه البيانات وعدل هذا السطر بما يناسب اسم ملفك

بجد أخي ياسر مش عارف كيف أشكرك ع تعبك .. لكن للأمانة انا ماعنديش خبرة في الأكواد اللي وضعتها .. 

كنت متوقع يكون الملف جاهز وانا اعدل بس بيانات الجدول .. لكن كفيت و وفيت يا طيب .. حفظك الله .. 

باين ان الموضوع يحتاج خبرة وانا الحق خبرتي بسيطه .. 

مشكور و آسف ع تعبك يا طيب .. 

[ياسر خليل أبو البراء]

أخي الكريم مجدي إليك الملف الأصلي الذي أرفقته

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

 

قم بفتح المصنف الذي يحتوي الكود "نموذج إستمرارية عمل" وغير الرقم في الخلية B1 ولاحظ النتائج

نموذج إستمرارية عمل.rar

[مجدي الطيب]

أخي الكريم مجدي إليك الملف الأصلي الذي أرفقته

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

 

قم بفتح المصنف الذي يحتوي الكود "نموذج إستمرارية عمل" وغير الرقم في الخلية B1 ولاحظ النتائج

ما شاء الله لا قوة إلا بالله .. حفظك الله ورعاك اخي ياسر .. 

بجد انا مش عارف كيف نشكرك لأنك وفرت عليا جهد و وقت كثيييييييير

سأقوم حالياً ببعض التعديلات لربطه بالملف الرئيس عندي وأرجو أن أوفق في هذا .. 

لكم مني مليون تحية .. وبارك الله فيك ونفع بيك المحتاجين اللي زيي     

[ياسر خليل أبو البراء]

الحمد لله الذي بنعمته تتم الصالحات والحمد لله أن تم المطلوب على خير

حاول تدرس الكود بشكل مكثف ولو وجدت مشكلة في فهم جزئية معينة أعملنا بها وإن شاء الله تجد المساعدة من إخوانك

مشكور على كلماتك الرقيقة

تقبل تحياتي

[مجدي الطيب]

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

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

[ا بو سليمان]

أخي وحبيبي أبو سليمان

مش ناوي تكون شمعة معايا عشان شمعتي قربت تنطفي

 

ان شاء الله مش حتنطفي  ....لان وقودها الحسنات  التي  لا تنظب من  مهديها وكاتبها