مختار حسين محمود

كل سنه وحضراتكم طيبين بمناسبة المولد النبوى الشريف كنت قدمت لكم موضوع سابق بعنوان كود يحذف نفسه بعد ما يشتغل مرة واحدة على الرابط التالى http://www.officena.net/ib/index.php?showtopic=57103 واليوم أقدم لكم يمناسبة المولد النبوى الشريف : كيف يحذف كود أخيه ويطرده بره الشقة آســـــــــــف الــــ workbook وذلك من خلال اطار فكاهى تعليمى وقبل تحميل هذا الملف ضع فى اعتبارك ما يلى : 1- الموضوع ليس له علاقه بالواقع السياسى المصرى 2- الموضوع تعليمى وتعليمى بحت فى المقام الاول 3- الموضوع يعبر عن التعلم من خلال اطار فكاهى بعيد عن جفاف المواد العلمية راحع أيضا تلك الموضوعات كمثال آخر عن التعلم من خلال الفكاهة الاكسل فى امتحان درس تعليمى http://www.officena.net/ib/index.php?showtopic=57678#entry366848 اجعل الاكسل المتحدث الرسمى باسمك http://www.officena.net/ib/index.php?showtopic=55015 4- لابد من تمكين الماكرو قبل مشاهده هذا العمل الأكواد المستخدمة فى الموضوع مصحوبة بالشرح Sub DELETE_Hamdan() ' الاعلان عن المتغير Dim vbCom As Object ' رسالة النطق بالحكم MsgBox "حكمت المحكمة على الكود قاتل المتظاهرين حمدان القط بالإعدام حذفاً ", vbInformation + vbMsgBoxRight, " القاضى العادل " Set vbCom = Application.VBE.ActiveVBProject.VBComponents ' تنفيذ الحكم على حمدان vbCom.Remove VBComponent:= _ vbCom.Item("حمدان") ' رسالة تنفيذ الحكم MsgBox " تمام يا أفندم تم تنفيذ الحكم ", vbInformation + vbMsgBoxRight, " عشمــــــــــاوى " End Sub الكودان التاليان خاصان بإعادة محاكمة الكود حمدان ( استعادة الكود بعد حذفه ) Sub CloseMe() ' تحديد المدة الزمنية التى يتم بعدها تشغيل الكود "OpenMe" "Application.OnTime Now + TimeValue("00:00:10"), "OpenMe" Savechanges = False ' لمنع الحفظ ThisWorkbook.Close False ' لمنع غلق الملف End Sub Sub OpenMe() ' رسالة النطق بالحكم الجديد MsgBox " !!!حكمت المحكمة ببراءة حمدان القط من قضية قتل المتظاهرين لأنه ما كانش يقصد ", vbInformation + vbMsgBoxRight, " القاضى العادل قوى" End Sub الكود التالى هو الكود حمدان ( أى كود يؤدى الغرض ) Sub Killfile() Dim MyFile As String On Error Resume Next MyFile = "c:\My Document\mokhtar.xls" kill MyFile End Sub ماذا نتعلم من هذا الموضوع 1- كيف يحذف كود كوداً غيره 2 - التراجع عن تنفيذ الماكرو راجع هذا الموضوع كمثال للتراجع عن كود undo macro by mokhtar (هديتى بمناسبة السنة الجديدة ) http://www.officena.net/ib/index.php?showtopic=57976 تفضلوا المرفق ولا تنسوا الدعاء للمرحوم أبى فدعوة بظهر الغيب تكن لك وله نورا يوم القيامة وكل سنة وحضراتكم طيبين كود فى قاعة محكمة.rar

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

السلام عليكم اخوانى وأحبابى كل سنه وحضراتكم طيبين بمناسبة السنه الجديدة نسأل الله عزوجل أن تكون سنة خير وسعاد ة علينا وعليكم وعلى مصر والعالم العربى والاسلامى و كل سنه وحضراتكم طيبين بمناسبة المولد النبوى الشريف الدنيا كلها مناسبات حلوه وأنا معاى هديتين هديتى بمناسبة السنه الجديدة طريقة مبتكرة للتراجع عن تنفيذ الماكرو . لنفرض أن حضرتك بتشتغل على الاكسل و ايدك خبطت فى زر حذف بيانات بالورقة مثلا بتتصرف ازاى فى هذه الحالة ؟ قدامك 3 طرق : الأولى ما تعرفش تتصرف وتقعد تبكى على البيانات الثانية تقفل الاكسل بدون ما تحفظ وتعيد فتح الملف من جديد الثالثة تستخدم الكود التالى ( فكرته نابعة من الطريقة الثانية بس بنريحك من قفل الملف وإعادة فتحه ) وهذا هو شرح الأكواد المستخدمة : الكود التالى لحذف بيانات Sub DELEDTE() ' تحديد مدى معين Range("a1 :c10").Select ' حذف البيانات Selection.ClearContents ' الوقوف على الخلية a1 Range("a1 ").Select End Sub الكود التالى لتشغيل الكود الذى يليه بعد مدة زمنية ومنع حفظ التغييرات الأخيرة فى الملف Sub CloseMe() ' هنا نحدد المدة الزمنية التى يعمل بعدها الكود "OpenMe" Application.OnTime Now + TimeValue("00:00:10"), "OpenMe" ' هنا نحدد منع حفظ التغييرات ومنع غلق الملف نهائيا Savechanges = False ThisWorkbook.Close False End Sub الكود التالى للتأكيد على عودة البيانات Sub OpenMe() ' رسالة تأكيد عودة البيانات MsgBox " البيانات رجعت ! خلى بالك يا أفندينا مش كل مرة تسلم الجرة " End Sub احنا بكده نكون اتعلمنا جاجتين : الأولى التراجع عن ماكرو الثانية : ودى مهمة خالص وكتير مننا مش واخد باله منها وهى ( كيفية تشغيل ماكرو عن طريق ماكرو آخر ) أتمنى أن يكون الموضوع أعجبكم ودعواتكم للمرحوم أبى ( دعوه بظهر الغيب تكون فى ميزان حسناتك ) هذه هى هديتى الأولى بمناسبة السنة الجديدة انتظروا هديتى الثانية الليلة بمناسبة المولد النبوى الشريف ( كود X قاعة المحكمة ) وهذا المرفق تطبيق على الموضوع والسلام عليكم انتظرونى قبل منتصف الليلة undo macro by mokhtar.rar

بارك الله فيك أخوى خيماوى نورت الموضوع بزيارتك

أستاذى العزيز بارك الله فيك الفكرة جميلة جعلها الله فى ميزان حسناتك أنا بزورك اهــــه وايدى مش فاضيه : ' الكود التالى للحفظ والخروج التلقائى من اكسل يوضع فى حدث الـ Workbook Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.DisplayAlerts = False ThisWorkbook.Save Application.Quit End Sub الكود التالى : مديول عادى للحفظ والخروج من الملف Sub Close_File() ThisWorkbook.Save ThisWorkbook.Close End Sub الكود التالى مديول عادى للحفظ والخروج نهائيا من اكسل Sub Close_Excel() ThisWorkbook.Save Application.Quit End Sub ملحوظه هامة أرجو تعديل المرفق بحيث يكون العمل من خلال اليوزرفورم فقط تحياتى لكم

جرب المرفق test9009.rar

جرب ملف1.rar

أولا أساتذتى واخوانى السلام عليكم ورحمة الله وبركاته ثانيا بارك الله فييك اخى 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 ' وسلام الله عليكم ورحمته وبركاته .

السلام عليكم أستاذى الفاضل بن عليه كلمة حق أقولها ولا أنكرها لى الشرف أن أكون تلميذا لكم فأنت من أوائل الذين ساعدونى فى المنتدى ( ألا تذكر أنك عملت لى القائمة المنسدلة التى نظهر منها مادة دراسية ونخفى الباقى ) سيدى الكريم الموضوع مش حكاية ملفين زى بعض الموضوع فيه حاجتين أو فكرتين يمكن أن نستفيد منهما الأولى لو عندى ملف مغلق نستطيع أن نأتى بالبيانات دون فتحة .وهذا يمثل عملية النقل الأولى الفكرة الثانية التى يمكن الاستفادة منها أنه لو عندنا ملف نستطيع أن ندخل اليه بيانات دون الذهاب اليه ودون أن يشعر أى شخص بجوارك بأنك أدخلت بيانات الى هذا الملف وهذا يمثل عملية النقل الثانيه . كما أننا نستطيع أن نستفيد من الموضوع ككل فى امكانية النقل والترحيل من 3 ملفات دفعة واحدة ويمكن أن نرحل بيانات من أى عدد من الملفات تريده بالتغيير فى الأكواد بعد كده كان ممكن أعرض الموضوع على جزئين كل جزء فيه فكرة من الفكرتين لكنى آثرت الدمج لجذب الإنتباه أظن حضرتك فهمتنى تقبل تحياتى . **************************************************************************************************** الأستاذ أبو سليمان الموضوع زاد نورا بمررك **************************************************************************************************** الأخ العزيز أبوتراب أخى لقد قطعت على نفسى عهدا أن أقدم لكم كل جديد أتعلمه بارك الله فيك وفى مرورك الكريم

الأستاذ أبو ايمان السلام عليكم عذرا عن التأخر عن اجابتك كنت مشغول شويه والنت ضعيف فى أوفيس 2003 ضع الملفات بعد فك الضغط عنها فى المسار التالى : C:\Documents and Settings\mokhtar\Application Data\Microsoft\Templates مع مراعاة تغيير الأسم mokhtar بما يتوافق مع ما كتبته وقت تنصيبك الويندو من قائمة أدوات اختر قوالب ووظائف اضافية فى المربع الحوارى التالى إضغط على زر إضافة حدد القالب الأول ثم انقر على موافق .. ثم كرر ماسبق بالنسبة للقالب الثانى ثم الثالث سوف تلاحظ وجود أشرطة أدوات جديدة تحتوى على العديد من الرموز والأشكال الرياضية أما الخطوط الثلاثة توضع فى المسار التالى windows ثم fonts تقبل تحياتى لك ولأستاذى العزيز ياسر

الاضافات الجديدة على الرابط التالى : http://www.officena.net/ib/index.php?showtopic=57903#entry368572 ستعرفون معلومات بسيطة عن طريقة ADO فى ترحيل ونقل البيانات وستعرفون كيفية جلب بيانات من 3 ملفات مغلقة دفعة واحدة ثم ترحيلها وادخالها الى شيت مغلق آخر دون شعور المستخدم بذلك .

السلام عليكم أساتذتى واخوانى بالمنتدى تناولت فى موضوعى السابق طريقة نقل بيانات من ملف مغلق الى ملف مغلق أخر بطريقة تسمى 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

الأستاذ الكريم على المصرى كل سنة وحضرتك طيب آمين آمين آمين تقبل الله دعاءك وجعله فى ميزان حسناتك ( بلدياتى مش كده ؟) الأستاذ أبو محمد عباس السلام عليكم ورحمة الله وبركاته بارك الله لك وعليك وفيك ربنا يدينا ويديك الصحة أستاذى العزيز/ ياسر كله بفضلكم وتشجيعكم لى ربنا يخليك ليه يا أستاذى العزيز ******************************************************* انتظرونى فيه اضافه مهمة للموضوع

للأخوة اللى مش واخدين بالهم من الملف الجديد . اعذرونى على اتجاه الكتابه أظن صعب عليه أظبط ده كله الملف الجديد فيه ننقل البيانات من ملف مغلق الى ملف مغلق والملفان كل منهما فى مسار مختلف والنقل تم بكود كما وعدتكم . يمكن تحميله من الميديا فاير على الرابط التالى : http://www.mediafire.com/download/df17y8oe81f1brk/copy__data_from_a_closed_excel_file__&_paste_it_in_a_closed_excel_file_by_mokhtar_(__2_).rar أو تحميله من المرفقات. وتحياتى لكم ومحدش يسيب الموضوع ( لسه فيه باقى ) copy data from a closed excel file & paste it in a closed excel file by mokhtar ( 2 ).rar

السلام عليكم أساتذتى وإخوانى فى المشاركة الأولى تم طرح كيفية نقل البيانات من ملف مغلق الى آخر مغلق استخدمت فيها كودين كنت لا أعرف من صاحبهما وجائى تعقيب من أستاذى الفاضل بن عليه حاجى أكد فيه على أهمية الموضوع وشىء من هذا القبيل إلا أنه أوصانى بذكر المصادر احقاقا للحق وكنت وعدتكم بأنى سوف أنقل البيانات من مختار2 الى مختار3 بكود بدلا من اللينك وأنا عملت بهذه النصيحة فأعدت البحث مرارا حتى توصلت الى المصادر التى اعتمدت عليها كما أن الله عز وجل وفقنى الى ما وعدتكم به أما عن المصادر وكيفية التوصل للكود سوف تعرفونها من المقاله التاليه والتى كتبتها باللغة الانجليزية اعذرونـــــــى على هـــذا . كما ألتمس العذر على السهو والخطأ فى اللغة الإنجليزية Hi All Firstly if we have a 3 excel files mokhtar1 , mokhtar2 & mokhtar3 mokhtar1 & mokhtar2 in the same path mokhtar3 in a different place like : ("C:/TEMP/mokhtar3.xls") we can copy "A1:C5" from "Sheet1 in the closed file ( mokhtar1) W.B and paste data in the ( mokhtar2) W.B then we export it to the ( mokhtar3) W.B 1- Copy data from ( mokhtar1) to ( mokhtar2 ==================================== to do that open the workbook ( mokhtar2) then click import tab we use ADO to copy data from a closed workbook ( mokhtar1 without opening the workbook then paste it in the workbook ( mokhtar2) Note: * You can also use a named range " if you want like "Mydat If you want to copy only one cell use "A1:A1" and not "A1"in the code for more info about Ado See this page http://support.microsoft.com/kb/278973 Ron de Bruin did this function GetData Thanks Ron very very very mutch for info about Ron de Bruin see http://mvp.microsoft.com/en-US/search-mvp.aspx?kw=Ron+de+Bruin 2 - Export data TO a closed workbook =============================== we can not put ANY data in ( mokhtar3) without open it, it is a closed file I'm hunt for a code to do this IN SITES I FOUND a good one at http://www.ozgrid.com/forum/showthread.php?t=89776 Sub CopyIt() Dim wbCopy As Workbook Dim wbPaste As Workbook Application.ScreenUpdating = False Set wbCopy = Workbooks.Open("full path here/Recent Faxes.xls") Set wbPaste = Workbooks.Open("full path here/Current Documentation.xls") wbCopy.Sheets(1).Range("AA47").Copy With wbPaste.Sheets(1).Range("B25") .PasteSpecial xlValues .PasteSpecial xlFormats End With wbCopy.Close , False wbPaste.Close , False Application.ScreenUpdating = True End Sub this Dave HAWLY'code Thanks Dave HAWLY very mutch Dave'S code OPEN FILE" wbPaste" THEN put Data DIRECTLY WITH FEELING OF USER i have devloped it to this 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 MY code open a closed file mokhtar3 and put the data on it, then close it quickly without feeling of the user as app works in back this is my idea TO export data from a closed workbook to a closed workbook I hope that it is easy to use ========================= Download filse from here : http://www.mediafire.com/download/df17y8oe81f1brk/copy__data_from_a_closed_excel_file__&_paste_it_in_a_closed_excel_file_by_mokhtar_(__2_).rar =================================================================================== S.N VBA " 123 " { mokhtar1 , mokhtar2 & mokhtar3 } ==================================================================================== Thanks 4 all H.Mokhtar HAM2DAY30@YAHOO.COM http://www.officena.net/ib EGYPT 29/12/2014 00.00 am

أستاذى الفاضل لاحظ أنه يجب أن يكون تنسيق الخلايا فى الملفات الثلاث واحد وموضوع الأصفار ده لأن حضرتك فى الكود اللى بيجيب الخلايا من مختار 1 الى مختار2 طلبنا احضار المدى كله ( a1:c5 ) الى مختار2 ومن ثم الى مختار3 لذلك الخلية التى بها داتا هنا بتروح الى هناك داتا والخلية الفارغة فى مختار 1 بتروح الى مختار 2 صفر وبالتالى بتكون فى مختار3 صفر لاحظ كمان أن فى الشيت الثالث لينك بيجيب البيانات من مختار2 ده ثابث ما بنغيروش التغيير فقط فقط فى الشيت مختار 1 لما نحب نعيد التجربة مع بيانات جديدة ولحضرتك جزيل الشكر أستاذى العزيز

أستاذى العزيز / ياسر اعمل تنسيق الخلايا فى الملفات الثلاث ( نص ) هتظبط معاك منتظر الرد ***************************************************** الأستاذ خالد الشاعر بارك الله فيك وشكرا على مرورك الكريم

الأستاذ الفاضل أبو عيد رحم الله موتانا وموتاكم وجعل قبورهم روضة من رياض الجنة مد بصرهم بارك الله فيكم وشكرا على مروركم الكريم ********************************************************************** الأخ زيزووووووووووو بارك الله فيك وشكرا على مرورك الكريم والله يا أخى ما هو ابداعى كله هى فكرة وأنا بنيت عليها ********************************************************************************* . أستاذى العزيز / أبوخليل نورت الموضوع فينك من بدرى ؟ ( سؤال مش أغنية ) وعدتكم بأن أقدم لكم موضوعات جديدة وها أنا أفعل وسوف أفعل بس لازم آخد فاااااااااااااااااااااااااااااااااااااااااااااااااصل عشان أقدر أواصل ولا إيه ؟! أرجو أن يعجبك الملف منتظر رأيك أيا كان وليعلم الجميع أن الكودين المهمين فى الموضوع طبعاً مش من عندى ( جهزوا لى محامى ) صاحبهم واحد معرفوش كان ناشره فى مشاركة لا أذكره ولا أنا فاكر موقعه أنا لما بقعد على النت أقعد أغوص أغوص أغوص فى بحر النت لاصطاد اللؤلو والمرجان وأخطف اللؤلؤة من دول ويا فكيك على نزلة باقور المهم الراجل ده عمل الكودين لاحضار بيانات من ملف مغلق وأنا والحمد لله كملت وحطيت نفس البيانات فى ملف برده مغلق الحج اياااااااه عمل كودين وجاب لى بيهم البيانات بس أنا وديتهم له بلينك ( أصل أنا لسه على أقدى ) :biggrin: وكلمه فى سركم (عشان أغيظه كتبت العنوان بتاع الموضوع بالإنجليزى... يمكن يطلع امريكانى ) :wavetowel: بس وحياة اللى كلت دراع جوزها لأنا موديهم له برده و بكود ( واااااااحد ) بس اصبروا علىّ شويه ( أنا دلوقتى x الفاصل ) انتظرونى وفى نفس الموضوع وتحياتى للجميع

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

متأسف أخى الكريم مخدتش بالى أنى فى قسم الاكسس هذا الكود خاص بالاكسل . متأسف مرة ثانيه . انتظر شويه وستجد من يلبى طلبك

السلام عليكم أساتذتى وإخوانى وأحبابى فى المنتدى :- ******************************************** مع كل شىء جديد فى الأكسل أصل إليه أحب أن أقدمه للمنتدى الذى تعلمت منه وفيه كرد للجميل الذى وهبنى إياه من قبل باختصار لو عندى 3 ملفات اكسل ( أ و ب و ج ) نقدر ننقل بيانات من ( أ ) إلى ( ج ) بدون فتح ( أ ) ولا فتح (ج ) ( انجليزى ده يا مرسى ؟؟؟؟ ) لأ مش انجليزى ولا ألمانى ولا حتى يابانى أو أمريكانى إنما هو مصرى خالص ووصعيدى كمان والمرفق التالى يوضح ذلك . طريقة التعامل مع المرفق : فك الضغط عن المرفق هتلاقى 3 ملفات mokhtar1 و mokhtar2 و mokhtar3 1- افتح mokhtar1 واكتب ما يبدو لك فى المدى المحدد ( A1 : C5 ) واقفله 2- رووووح على mokhtar2 فقط اضغط الزر " اقفل يا سمسم " 3- اجرى بسرعة على mokhtar3 وشوف النتيجة . الشرح والأكواد فى المرفق 123 كلمة سر الفيجوال بيسك . أكتفى بهذا الموجز وعلى حضرتك اكتشاف المزيد فى الملف . تحياتى لأساتذتى وزملائى copy data from a closed excel file & paste it in a closed excel file by mokhtar.rar

تفضل ضع هذا الكود فى حدث الــــــ w.b Private Sub Workbook_BeforeClose(Cancel As Boolean) If [A1] >= 5 Then GoTo 1 [A1] = [A1] + 1 1: ThisWorkbook.Save End Sub Private Sub Workbook_Open() If [A1] >= 5 Then MsgBox "لقد فتح الملف خمس مرات ولا يمكن فتحه مرة اخرى", , "تنبيه" ThisWorkbook.Save ThisWorkbook.Close End If End Sub a1 خلية تبين عدد مرات فتح الشيت تقبل تحياتى

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

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

اليك مثال لاخفاء عمود بناء على قيمة فى خليه اذا كانت القيمة اكبر من 180 يتم الاخفاء Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("A2").Value > 180 Then Columns("D").EntireColumn.Hidden = True End If End Sub ضع الكود فى حدث الورقة مع تحياتى اخفاء عمود بناء على قيمة خليه.rar