مختار حسين محمود قام بنشر ديسمبر 29, 2014 قام بنشر ديسمبر 29, 2014 السلام عليكم أساتذتى واخوانى بالمنتدى تناولت فى موضوعى السابق طريقة نقل بيانات من ملف مغلق الى ملف مغلق أخر بطريقة تسمى ado وهى اختصار للعبارة ActiveX Data Objects بدأ العمل بها فى مايكروسوفت 1996 تستخدم هذة الطريقة فى ترحيل ونقل البيانات بين الملفات استخدمت هذه الطريقة فى جلب البيانات الى شيت رئيسى ثم ربطت الشيت الرئيسى بشيت آخر بلينك . بعد ذلك قلت لنفسى لو عندى كود لادخال البيانات الى ملف مغلق يبقى الأمر 10/ 10 ثم بحث عن كود ووجدت واحد فى أحد المواقع الأجنبية وقمت بتعديله بطريقة لا يشعر فيها المستخدم بأن الملف ده اتفتح والتفاصيل هنا : http://www.officena.net/ib/index.php?showtopic=57798 والحمد لله تم استبدال اللينك بكود . وتركت لكم الملفات فى الرابط ده . مرة مستخدما اللينك ومرة الكود فى ادخال البيانات للملف المغلق . و اليوم أقدم لكم كيفية جلب البيانات من 3 ملفات مغلقة دفعة واحدة وبضغطة زر واحدة ومن ثم ترحيلها وادخالها الى ملف مغلق آخر دون شعور المستخدم بذلك وهذا يتم بذات الطريقة السابقة . للأصدقاء من خارج المنتدى : على الميديا فاير من خلال الرابط التالى http://www.mediafire.com/download/gidslzjdssb2jii/copy__data_from_a_closed_excel_file__&_paste_it_in_a_closed_excel_file_by_mokhtar_(__3_).rar للأصدقاء فى المنتدى : تفضلوا الملفات فى المرفق التالى . أرجوا أن يفيدكم وتستمتعوا به تحياتى للجميع copy data from 3 closed excel file & paste it in a closed excel file by mokhtar ( 3 ).rar 7 2
بن علية حاجي قام بنشر ديسمبر 29, 2014 قام بنشر ديسمبر 29, 2014 السلام عليكم ورحمة الله أخي الكريم مختار، عمل جميل جدا ومجهود كبير للتسهيل في عملية نقل بيانات من ملفات مغلقة إلى ملفات أخرى مغلقة... جازاك الله خيرا وبارك الله فيك وفي أهلك... وقد قمت بإضافة ملف جديد والتعديل على كودي Import و Export في ملف mokhtar ونجحت العملية... والسؤال هو هل يمكن الاستغناء عن مرور عملية الاستراد والتصدير بالملف mokhtar ؟ إذ أنه تصبح عندنا نسختين لنفس الملف mokhtar و mokhtar4 والفرق الوحيد بينهما هو وجود الأكواد في ملف mokhtar وقد قمنا بعملية النسخ واللصق مرتين مرة من الملفات الثلاثة الأولى إلى ملف mokhtar والثانية من ملف mokhtar إلى ملف mokhtar4... المهم جعل الله كل أعمالك في ميزان حسناتك... أخوك بن علية
ابو تراب قام بنشر ديسمبر 30, 2014 قام بنشر ديسمبر 30, 2014 جميل جميل يامختار ... استمرفي هذا الموضوع المهم ال ADO اداة رهيبة لنقل الاكسل الى مستوى قواعد البيانات و الاستعلامات SQL
مختار حسين محمود قام بنشر ديسمبر 30, 2014 الكاتب قام بنشر ديسمبر 30, 2014 (معدل) السلام عليكم أستاذى الفاضل بن عليه كلمة حق أقولها ولا أنكرها لى الشرف أن أكون تلميذا لكم فأنت من أوائل الذين ساعدونى فى المنتدى ( ألا تذكر أنك عملت لى القائمة المنسدلة التى نظهر منها مادة دراسية ونخفى الباقى ) سيدى الكريم الموضوع مش حكاية ملفين زى بعض الموضوع فيه حاجتين أو فكرتين يمكن أن نستفيد منهما الأولى لو عندى ملف مغلق نستطيع أن نأتى بالبيانات دون فتحة .وهذا يمثل عملية النقل الأولى الفكرة الثانية التى يمكن الاستفادة منها أنه لو عندنا ملف نستطيع أن ندخل اليه بيانات دون الذهاب اليه ودون أن يشعر أى شخص بجوارك بأنك أدخلت بيانات الى هذا الملف وهذا يمثل عملية النقل الثانيه . كما أننا نستطيع أن نستفيد من الموضوع ككل فى امكانية النقل والترحيل من 3 ملفات دفعة واحدة ويمكن أن نرحل بيانات من أى عدد من الملفات تريده بالتغيير فى الأكواد بعد كده كان ممكن أعرض الموضوع على جزئين كل جزء فيه فكرة من الفكرتين لكنى آثرت الدمج لجذب الإنتباه أظن حضرتك فهمتنى تقبل تحياتى . **************************************************************************************************** الأستاذ أبو سليمان الموضوع زاد نورا بمررك **************************************************************************************************** الأخ العزيز أبوتراب أخى لقد قطعت على نفسى عهدا أن أقدم لكم كل جديد أتعلمه بارك الله فيك وفى مرورك الكريم تم تعديل أبريل 29, 2015 بواسطه دغيدى
ياسر خليل أبو البراء قام بنشر ديسمبر 30, 2014 قام بنشر ديسمبر 30, 2014 تسلم يا أخ الغالي مختار موضوع في منتهى الروعة .. لي عندك طلب ..ابدأ في شرح كل فكرة على حدة وبالتفصيل عشان الكل يقدر يستفيد من الموضوع بشكل كبير
مختار حسين محمود قام بنشر ديسمبر 30, 2014 الكاتب قام بنشر ديسمبر 30, 2014 (معدل) أولا أساتذتى واخوانى السلام عليكم ورحمة الله وبركاته ثانيا بارك الله فييك اخى j011 ثالثا : أشكرك أستاذى الكريم ياسر خليل على مروك الكريم وتشجيعك لى وتنفيذا لتوجيهاتك أقدم للزملاء شرحا مبسطا : بعد ما نوحد ربنا ونصلى على المصطفى صللى الله عليه وسلم الموضوع حضراتكم فيه ثلاث أفكار يمكن تطبيقها 1 - نسخ أو جلب أو ترحيل بيانات من ملف مغلق واحد 2 - نسخ أو جلب أو ترحيل بيانات من أى عدد من الملفات المغلقة . 3- - ادخال بيانات الى ملف مغلق ( بطريقة لا تشعر فيها بأنه تمت عملية نسخ الى هذا الملف تماما مثل البرامج التى تعمل فى الخلفيه دون شعور المستخدم ) 1-الكود التالى نضعه فى حدث الـــــــ Workbook بتاع الملف المغلق اللى هننقل منه البيانات Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWorkbook.Save Application.Quit End Sub الكود يعمل على حفظ البيانات التى كتبناها فى الملف المغلق الذى نريد النقل منه كما أنه يغلق الاكسل بدون تدخل منك . **************************************************************************************** الكودان التاليان نضع كلا منهما ا فى مديول عادى فى الملف اللى هنحط فيه البيانات التى أخذناها من الملف المغلق وهما معا أحد تطبيقات نظام ado فلى نقل البيانات الكود الأول : نضعه كما هو بدون تتغيير : Public Sub GetData(SourceFile As Variant, SourceSheet As String, _ SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean) Dim rsCon As Object Dim rsData As Object Dim szConnect As String Dim szSQL As String Dim lCount As Long ' Create the connection string. If Header = False Then If Val(Application.Version) < 12 Then szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & SourceFile & ";" & _ "Extended Properties=""Excel 8.0;HDR=No"";" Else szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & SourceFile & ";" & _ "Extended Properties=""Excel 12.0;HDR=No"";" End If Else If Val(Application.Version) < 12 Then szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & SourceFile & ";" & _ "Extended Properties=""Excel 8.0;HDR=Yes"";" Else szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & SourceFile & ";" & _ "Extended Properties=""Excel 12.0;HDR=Yes"";" End If End If If SourceSheet = "" Then ' workbook level name szSQL = "SELECT * FROM " & SourceRange$ & ";" Else ' worksheet level name or range szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];" End If On Error GoTo SomethingWrong Set rsCon = CreateObject("ADODB.Connection") Set rsData = CreateObject("ADODB.Recordset") rsCon.Open szConnect rsData.Open szSQL, rsCon, 0, 1, 1 ' Check to make sure we received data and copy the data If Not rsData.EOF Then If Header = False Then TargetRange.Cells(1, 1).CopyFromRecordset rsData Else 'Add the header cell in each column if the last argument is True If UseHeaderRow Then For lCount = 0 To rsData.Fields.Count - 1 TargetRange.Cells(1, 1 + lCount).Value = _ rsData.Fields(lCount).Name Next lCount TargetRange.Cells(2, 1).CopyFromRecordset rsData Else TargetRange.Cells(1, 1).CopyFromRecordset rsData End If End If Else MsgBox "No records returned from : " & SourceFile, vbCritical End If ' Clean up our Recordset object. rsData.Close Set rsData = Nothing rsCon.Close Set rsCon = Nothing Exit Sub SomethingWrong: MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _ vbExclamation, "Error" On Error GoTo 0 End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function Array_Sort(ArrayList As Variant) As Variant Dim aCnt As Integer, bCnt As Integer Dim tempStr As String For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1 For bCnt = aCnt + 1 To UBound(ArrayList) If ArrayList(aCnt) > ArrayList(bCnt) Then tempStr = ArrayList(bCnt) ArrayList(bCnt) = ArrayList(aCnt) ArrayList(aCnt) = tempStr End If Next bCnt Next aCnt Array_Sort = ArrayList End Function الكود الثانى : ده توأم السابق يتعاونان معا فى سحب البيانات من الملف المغلق لكن الكود ده هو اللى هنلعب بيه الكورة ونغير فيه بكل سهوله وأريحيه Sub GetData_Example1() ' السطر الاول بنقول للكود هات البيانات من الملف المغلق الفلانى/ الشيت الفلانى ' السطر الذى يليه بنقول للكود انسخ المدى الفلانى من الشيت الفلانى 'وكمان الصق الكلام ده فى الخليه الفلانيه GetData ThisWorkbook.Path & "\mokhtar1.xls", "Sheet1", _ "A1:C5", Sheets("Sheet1").Range("AA1"), True, True ActiveWorkbook.Save Application.Quit End Sub ملحوظة مهمه فى الكود السابق :بص كده على الكلمتين دول True, True الكلمة الاخيرة تخلى الكود يظهر راس الصفحة ( لاحظ ذلك فى مرفق الموضوع ) أما لوكتبناهم بالشكل ده True, false رأس الصفحة مش هييجى ضمن البيانات التى أخدناها من الملف المغلق ايضا لاحظ هنا أننا بنا خد البيانات بتاعتنا من ملف اكسل مغلق واحد وبكده نكون خلصنا الفكرة الأولى . بعد ما خلصت الفكرة الاولى اخوانى شعرت بأنه لو يمكن ادخال البيانات الى ملف مغلق تبقى العمليه ايه !!!!!!!! ومن هنا ظهرت الفكرة الثانية الفكرة الثانيه : هى ادخال بيانات الى ملف مغلق طبعا ليس من المعقول ادخال البيانات الى ملف مغلق دون فتحه لذلك بحثت مرارا وتكرارا عن كود يفتح الملف المغلق وجربت أكتر من كود لحد ما عثرت على واحد سهل وحسيت منه أننى أستطيع تعديله وبالفعل تم الامر لى بعون الله وتوفيقه انظر الى الموضوع التالى : http://www.officena.net/ib/index.php?showtopic=57798 الكود ده غيرت فيه بحيت يفتح الملف ووتدخل البيانات بسرعة من غير ما حد يحس ان فيه حاجه حصلت وهذا هو الكود Sub export_data() Dim mokhtar2 As Workbook Dim mokhtar3 As Workbook Application.ScreenUpdating = False Set mokhtar2 = ActiveWorkbook Set mokhtar3 = Workbooks.Open("C:/TEMP/mokhtar3.xls") mokhtar2.Sheets(1).Range("A1:C5").Copy With mokhtar3.Sheets(1).Range("A1") .PasteSpecial xlValues .PasteSpecial xlFormats End With Application.Quit End Sub الكود السابق نضعه فى مديول عادى فى الملف اللى هنرحل منه الى الملف المغلق اللى هو فى الأصل الملف اللى بستورد اليه البيانات من الملف المغلق ( الملف الرئيسى ) الكود معناه : بنصرح للبرنامج ان مختار 2 ومختار 3 دول اعتبرهم Workbook ونشط لى مختار 2 وانسخ المدى a1 : c5 منه وطيران على المجلد temp اللى فى الــــ c هتلاقى هناك الملف المغلق مختار 3 افتحه وقله مختار 2 بيسلم عليك وباعتلك شويه البيانات دول بمناسبة المولد النبوى ورأس السنة الميلادية وقله لو سمحت يا عمو حطهم فى الخلية a1 ومتنساش تقفل الباب وراك يلا بسرعة كده ومن غير ما حد يحس بيك . وبكه نكون خلصنا من الفكرة الثانيه . ************************************************************ الفكرة الثالثه : وليدة الفكرة الأولى الا انها تقوم على النسخ من عدد غير محدود من الملفات المغلقه ( 2 3 4 5 6 7 ........) بعكس الفكرة الأولى التى ننسخ فيها بيانات من ملف مغلق واحد فقط والكود التالى يمثل النقل من 3 ملفات مغلقة mokhtar1 mokhtar2 mokhtar3 Option Explicit Sub GetData_Example3() 'السطران التاليان خاصان بالنسخ من الملف المغلق مختار 1 ' True, True لاحظ فيهما الكلمتين GetData ThisWorkbook.Path & "\mokhtar1.xls", "Sheet1", _ "A1:C12", Sheets("Sheet1").Range("A1"), True, True 'السطران التاليان خاصان بالنسخ من الملف المغلق مختار 2 GetData ThisWorkbook.Path & "\mokhtar2.xls", "Sheet1", _ "a2:c11", Sheets("Sheet1").Range("A13"), True, True 'السطران التاليان خاصان بالنسخ من الملف المغلق مختار 3 GetData ThisWorkbook.Path & "\mokhtar3.xls", "Sheet1", _ "E1:E23", Sheets("Sheet1").Range("E1"), True, True 'وبنفس الكيفية يمكنك زيادة عدد الملفات المغلقة End Sub ' وسلام الله عليكم ورحمته وبركاته . تم تعديل ديسمبر 30, 2014 بواسطه مختار حسين محمود 1 1
خيماوي كووول قام بنشر ديسمبر 31, 2014 قام بنشر ديسمبر 31, 2014 الله يجزيك كل خير ... في ميزان حسناتك اخوي مختار ..
مختار حسين محمود قام بنشر ديسمبر 31, 2014 الكاتب قام بنشر ديسمبر 31, 2014 بارك الله فيك أخوى خيماوى نورت الموضوع بزيارتك
ابو جودى قام بنشر أبريل 29, 2015 قام بنشر أبريل 29, 2015 رائع اخى مختار فى المشاركة الثامنة الكود قبل الاخير كيف نغير اسم الملف مختار 3 بحيث يتم الترحيل لاى ملف اكسل مغلق داخل الفولدر عذرا لا اجيد موضوع الاقتباس
مختار حسين محمود قام بنشر أبريل 29, 2015 الكاتب قام بنشر أبريل 29, 2015 (معدل) أخوتى وليد زقزوق و عمرو طلبة ارك الله فيكما أخى عمرو اسم الملف واسم الشيت واسم المدى المنسوخ منه أو اليه لا يهم مفيش مشكلة أبدا كل اللى عليك أن تشيل ده وتحط ده لا أكثر تم تعديل أبريل 29, 2015 بواسطه مختار حسين محمود
ابو جودى قام بنشر أبريل 29, 2015 قام بنشر أبريل 29, 2015 استاذ مختار اريد استبدال ملف مختار 3 بعدد كبير من الملفات
مختار حسين محمود قام بنشر أبريل 29, 2015 الكاتب قام بنشر أبريل 29, 2015 (معدل) معلش يا عمرو انشغلت شويه عنك هل تقصد أنك تريد أن تنسخ بيانات من عدد كبير من الملفات المغلقة GetData ThisWorkbook.Path & "\mokhtar3.xls", "Sheet1", _ "E1:E23", Sheets("Sheet1").Range("E1"), True, True 'وبنفس الكيفية يمكنك زيادة عدد الملفات المغلقة الجزء ده كرره فى الكود زى ما أنت عايز مع أى عدد من الملفات المغلقة التى تريد النسخ منها غير اسم الملف واسم الشيت والمدى المنسوخ تم تعديل أبريل 29, 2015 بواسطه مختار حسين محمود
ا بو سليمان قام بنشر أبريل 29, 2015 قام بنشر أبريل 29, 2015 اخي مختار بارك الله فيك انا لدي ملفات متعدة ارغب بان اجمع بيانات من تلك الملفات الى ملف واحد فقط مع العلم ان البيانات التي في الجداول المتعدةه تتحدث وسبق وكتبت موضوع بهذا الخصوص
ا بو سليمان قام بنشر أبريل 29, 2015 قام بنشر أبريل 29, 2015 http://www.officena.net/ib/index.php?showtopic=60533
ابو جودى قام بنشر أبريل 29, 2015 قام بنشر أبريل 29, 2015 عفوا استاذ مختار ليس ذلك المطلوب المطلوب نسخ بيانات من مختار 2 الى كل ملفات الاكسل داخل الفولدر
مختار حسين محمود قام بنشر أبريل 29, 2015 الكاتب قام بنشر أبريل 29, 2015 أخى سليمان سوف أطلع على الرابط أخى عمرو أكرمك الله مختار 1 زى مختار 2 زى مختار 3 .....مختار 10000.الخ كلها ملفات مغلقة والسلام بها بيانات ونحن بنجمع البيانات منها ونحطها فى ملف واحد مغلق نسمية مختار نسميه عمرو نسميه ملف التجميع أى شىء من ذلك أرجو أن تكون الفكرة وصلت
ابو تريكة قام بنشر أبريل 30, 2015 قام بنشر أبريل 30, 2015 بارك الله فيك وجزاك عنا خيرا اخي الكريم مختار تم تطبيق الكرد بصراحه ابداع ولكن ظهرت لي مشكلة ان اول صف من كل شيت من الشيتات المجمعه في الملف يكون بياناته مخربه حتى بعد التعديل على الملفات الفرعية وتغيير القيم .. أيضا تظهر القيم بشكل غريب يعني اذا كانت يوجد في الصف الاول فقط خليتين من ضمن البيانات فارغتين يظهرو في التجميع في شكلل f9 & f8 & f5 وتكرر المشكلة في كل شبت اما بافي الصفوف في كل شيت تمام أرجو التوضيح وشكرا لك
مختار حسين محمود قام بنشر أبريل 30, 2015 الكاتب قام بنشر أبريل 30, 2015 لا أستطيع الرد الا اذا رأيت الملف لكن انظر الى الكود Sub GetData_Example1() ' السطر الاول بنقول للكود هات البيانات من الملف المغلق الفلانى/ الشيت الفلانى ' السطر الذى يليه بنقول للكود انسخ المدى الفلانى من الشيت الفلانى 'وكمان الصق الكلام ده فى الخليه الفلانيه GetData ThisWorkbook.Path & "\mokhtar1.xls", "Sheet1", _ "A1:C5", Sheets("Sheet1").Range("AA1"), True, True ActiveWorkbook.Save Application.Quit End Sub فى السطر ده "A1:C5", Sheets("Sheet1").Range("AA1"), True, True تحديدا تأكد من الكلمتين True, True لو الثانية false غيرها الى True
ا بو سليمان قام بنشر مايو 1, 2015 قام بنشر مايو 1, 2015 اخي مختار هل فيه امكانية للشرح من خلال مقطع مصور
ابو تريكة قام بنشر مايو 3, 2015 قام بنشر مايو 3, 2015 (معدل) السلام عليكم اخي الكريم مختار المشكله اللى ظهرت معايا في الملف الملف المرفق وشكرا لحضرتك جدا 123.rar تم تعديل مايو 3, 2015 بواسطه ابو تريكة
Yasser Fathi Albanna قام بنشر مايو 3, 2015 قام بنشر مايو 3, 2015 أخى الحبيب / مختار عمل رائع ومفيد جدا جدا جزاك الله به كل خير إستمر
مختار حسين محمود قام بنشر مايو 3, 2015 الكاتب قام بنشر مايو 3, 2015 أخى الحبيب بوتريكة بعد الاطلاع على المرفق الخاص بكم وجدت أنه ليس هناك مشكلة كل اللى عملته حضرتك 10/ 10 الأخطاء الحمراء f1 f2 f3 f4 التى فى ملف التجميع سببه أن الخلايا فى الملف الأصلى فارغة واذا وجدت رقم فى ملف التجميع لون الخط فيه أحمر فهذا بسبب تنسيق الخلية أصلا للعلم أن الدالات تحمل جدول من a1 : t26 كله كده على بعضه به بيانات أم لا لا يهم تنقل البيانات الى ملف التجميع والخلايا الفارغة هتلاقى مكانها الافات دى . جرب تعبئة الخلايا الفارغة فى الجدول بالملفات الثلاثة ستجد أنه لا شىء من هذا القبيل تحياتى لك الأستاذ الفاضل ياسر فتحى أسعدنى جدا مروركم وجازاكم الله خيرا
الردود الموصى بها