أكاديمية الصقر للتدريب

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


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





مشروع استقبال الشكاوي و المقترحات عن طريق الاكسيل

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


موضوع مغلق


29-01-2021 01:30 صباحا
fathy
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 17-03-2020
رقم العضوية : 18571
المشاركات : 89
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 142
 offline 

السلام عليكم ورحمة الله وبركاتة ..... عمل زر مايكرو ترحيل خلية الى ملف اكسيل اخر 
محتاج كود لهذا المشروع البسيط وهو عبارة عن استقبال الشكاوي و المقترحات عن طريق الاكسيل وهو عبارة عن ملفين اكسيل بصيغة المايكرو
حيث ملف اكسيل ( file1.xlsm ) هو الملف و الصفحة الرئيسية و ملف ( file2.xlsm ) هو الملف استقبال وحفظ الشكاوي 
ويوجد خلية F25 في ملف file1 هو نص الشكوى المراد ترحيلة في ملف اكسيل اخر 
المطلوب كود  فتح الملف file2 تلقائي ثم ترحيل القيمة من خلية F25 من ملف file1 الى ملف اكسيل ( file2.xlsm ) في اخر خلية في عمود B في شيت رقم 1
ثم نسخ اخر خلية في عمود A من ملف ( file2.xlsm ) وهو رقم الشكوى
و لصقها  في ملف ( file1.xlsm ) في خلية f21 وهو خلية رقم الشكوى في شيت رقم 2
وهذا الكود يتم تنفيذة عن طريق زر مايكرو من الملف الرئيسي 
ومحتاج لو عند الضغط على الزر لتنفيذ الامر لا يقم بالتنقل بين الملفين اثناء النسخ و اللصق بل اريد ملف file1 الصفحة الرئيسية  يكون ثابت  
و هذا المشروع يعتبر كامل ولاكن  ينقصة زر التنفيذي 
حيث ملف file2 يوجد بها كود ترقيم تلقائي و كتابة التاريخ و الوقت تلقائي و اتصال خلايا عمود B بالتكست بوكس تلقائي لسهولة قرائة نص الشكاوي اذا كانت بها كلمات كثيرة 
و اليكم المرفقات في ملف مضغوط 
ارجو ان اكون قد وقفت في شرح المطلوب

واشكركم جميعا و تفضلو بقبول وافر الاحترام و التقدير



 
 
Create micro button Migrate a cell to another excel file
 
 
 
  الشكاوي و المقترحات.rar   تحميل rar مرات التحميل :(2)
الحجم :(31.129) KB



أفضل إجابة مقدمة من حسين مامون وهي:
ربما تقصد هذا التعديل في الماكرو
Sub Macro9()
   Application.DisplayAlerts = False
 Application.ScreenUpdating = False
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(2)
Dim RG As Range: Set RG = ws.Range("F25")
Dim NM As Range: Set RG = ws.Range("F21")
Dim wb As Workbook
Dim wbs As Worksheet
Set wb = Workbooks.Open(ThisWorkbook.Path & "\file2.xlsm", True, , True, Password:="123")
Set wbs = wb.Sheets(1)
lr = wbs.Range("b" & Rows.Count).End(xlUp).Row + 1
wbs.Range("b" & lr).Value = RG
wbs.Range("a" & lr) = wbs.Range("a" & lr - 1) + 1
wbs.Range("b" & lr).Offset(, 1) = Date
wbs.Range("b" & lr).Offset(, 2) = Time
wbs.Range("b" & lr).Offset(, 3) = Date + Time
lr = wbs.Range("b" & Rows.Count).End(xlUp).Row
ws.Range("F21").Value = wbs.Range("a" & lr).Value
wb.Save
wb.Close

Range("F25").Select
Application.DisplayAlerts = True
Application.CutCopyMode = True

End Sub

 
عرض الإجابة




29-01-2021 04:15 صباحا
مشاهدة مشاركة منفردة [1]
fathy
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 17-03-2020
رقم العضوية : 18571
المشاركات : 89
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 142
 offline 
look/images/icons/i1.gif مشروع استقبال الشكاوي و المقترحات عن طريق الاكسيل
انا حولت اعمل الكود بشكل المطلوب ولاكن ينقصني شيئ مهم جدا و هو عدم التنقل بين الملفين اثناء النسخ و اللصق و هذا يسبب بطء في تنفيذ كامل الكود عند النقر على زر تنفيذ المايكرو 

بل اريد ملف file1 يكون نشط دائما و ثابتة و عند انتهاء الكود يغلق الملف الاخر 

و ارفقت لكم الملف وبها الكود لفهم قصدي في عمل الكود 
و محتاج بس اسرع الكود و الملف يفضل ثابت 
باسورد ملف file2 هو 123 و اعطيت امر انة يفتح المصنف محمي من الخارج و ينتهي الكود بحفظ وغلق المصنف و تحديد الخلية في file1
و اشكركم جميعا والله يجازيكم كل خير 
 
 
  الشكاوي و المقترحات 2.rar   تحميل rar مرات التحميل :(7)
الحجم :(51.725) KB


29-01-2021 05:57 مساء
مشاهدة مشاركة منفردة [2]
حسين مامون
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 23-08-2017
رقم العضوية : 69
المشاركات : 172
الجنس : ذكر
الدعوات : 1
يتابعهم : 5
يتابعونه : 12
قوة السمعة : 957
عدد الإجابات: 22
 offline 
look/images/icons/i1.gif مشروع استقبال الشكاوي و المقترحات عن طريق الاكسيل
ربما تقصد هذا التعديل في الماكرو
Sub Macro9()
   Application.DisplayAlerts = False
 Application.ScreenUpdating = False
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(2)
Dim RG As Range: Set RG = ws.Range("F25")
Dim NM As Range: Set RG = ws.Range("F21")
Dim wb As Workbook
Dim wbs As Worksheet
Set wb = Workbooks.Open(ThisWorkbook.Path & "\file2.xlsm", True, , True, Password:="123")
Set wbs = wb.Sheets(1)
lr = wbs.Range("b" & Rows.Count).End(xlUp).Row + 1
wbs.Range("b" & lr).Value = RG
wbs.Range("a" & lr) = wbs.Range("a" & lr - 1) + 1
wbs.Range("b" & lr).Offset(, 1) = Date
wbs.Range("b" & lr).Offset(, 2) = Time
wbs.Range("b" & lr).Offset(, 3) = Date + Time
lr = wbs.Range("b" & Rows.Count).End(xlUp).Row
ws.Range("F21").Value = wbs.Range("a" & lr).Value
wb.Save
wb.Close

Range("F25").Select
Application.DisplayAlerts = True
Application.CutCopyMode = True

End Sub

 

29-01-2021 06:39 مساء
مشاهدة مشاركة منفردة [3]
fathy
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 17-03-2020
رقم العضوية : 18571
المشاركات : 89
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 142
 offline 
look/images/icons/i1.gif مشروع استقبال الشكاوي و المقترحات عن طريق الاكسيل
انا اشكرك جدا اخي حسين الكود ممتاز ولا كن قم بتعديل الكود في نص الاجابة

Dim NM As Range: Set RG = ws.Range("F21")
 الى 
Dim NM As Range: Set RG = ws.Range("F25")

او الغائة لانة ينسخ رقم الشكوى مكان نص الشكوى 
حتى يرى اشخاص اخرون حل المشكلة صحيحة 
انا اشكرك جدا و اشكر جميع اعضاء و مديرين ومشرفين  المنتدى 

29-01-2021 06:44 مساء
مشاهدة مشاركة منفردة [4]
حسين مامون
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 23-08-2017
رقم العضوية : 69
المشاركات : 172
الجنس : ذكر
الدعوات : 1
يتابعهم : 5
يتابعونه : 12
قوة السمعة : 957
عدد الإجابات: 22
 offline 
look/images/icons/i1.gif مشروع استقبال الشكاوي و المقترحات عن طريق الاكسيل
الحمد لله ان تم الامر كما تريد
المهم تفهم الكود وتتعلم لتقوم باي تعديل بنفسك
 



الكلمات الدلالية
مشروع ، استقبال ، الشكاوي ، المقترحات ، طريق ، الاكسيل ،


 










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

الساعة الآن 11:10 صباحا