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

يشرفنى مرورك دائما أخى وأستاذى ياسر

بسم الله الرحمن الرحيم والصلاة والسلام على أول الأنبياء وخاتم المرسلين سيدنا محمد ( صلى الله عليه وسلم ) صلاةً الى يوم الدين إخوانى وأحبابى وزملائى وأساتذتى فى منتدانا العريق السلام عليكم ورحمة الله وبركاته أما بعد يشرفنى أن أقدم لحضراتكم طريقة استدعاء أى برنامج من الاكسل من خلال القاعدة الأساسية الآتية : Call Shell("C:\TEST\TestApplication.exe", vbNormalFocus) لاحظ أخى الكريم مسار وامتداد البرنامج الذى نستدعيه ده يفرق كتير يمكن استدعاء Notepad Control PaneL taskmgr SnippingTool calc WORD POWERPNT iexplore Firefox كل هذا وأكثر ======= vbNormalFocus لجعل نافذة البرنامج الذى نستدعيه عادية vbMaximizedFocus للجعل نافذة البرنامج الذى نستدعيه مكبرة فى المرفقين التاليين أمثلة متعددة ومتنوعة لاستدعاء البرامج (متوافق مع ويندوز 7 ) أتمنى أن تستفيدوا منه لكم منى كل محبة وتقدير واحترام *************** Open any Program from Excel.rar games by mokhtar.rar

هذا هو التميز تحياتى

السلام عليكم بارك الله فيك أخي العزيز وجعله في ميزان حسناتك أيوه كده حرك المياه الراكده

استاذى الحبيب ياسر خليل تقبل الله منا ومنكم صالح الاعمال . وجعله فى ميزان حسناتكم

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

بارك الله فيك أخى خالد شرفت بمرورك الكريم

بسم الله ما شاء الله جميل جدا أخى الزبارى بارك الله فيك تمت التجربة بنجاح مع i.e browser لكن أريد أن يعمل الكود على Mozilla Firefox تحياتى

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

بارك الله فيك أستاذى العزيز وجازكم خير الجزاء في الدنيا والآخرة . لك منى :fff:

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

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

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

أخى أبى الحسن والحسين بارك الله فيكم . لفبك جميل يا أخى بيفكرنى بآل البيت رضوان الله عليهم . أستاذ زيزو بارك الله فيكم وسعدت بمروركم أخى الكريم . لكما منى

السلام عليكم ورحمة الله وبركاته أخى أبى الحسن والحسين بارك لله فيكم وشرفت بمروركم أخى أحمد مرجان بارك الله فيكم أخى احمد من الطبيعى أن يتم الحفظ فى ثوان معدودة لكن كونه يأخذ 20 دقيقة ده مش طبيعى بالنسبة لفكرة الموضوع أعتقد أنك فاهمها : بمجرد ترك الملف وعدم التعديل عليه تبدأ الفترة الزمنية المعدة سابقا فى العمل حتى اذا ما انتهت يحدث أمر الاغلاق . وأعتقد أن الفترة الزمنية التى يأخذها ملفك فى عملية الحفظ بعيدة كل البعد عن فنرة الاستخدام لماذا ؟ لأن فيه كود بيعمل الحفظ أى أنه فيه عمل وتغيرات بتحدث اذن فنحن لم ندخل بعد فى فترة عدم الاستخدام والله أعلى وأعلم أخى عبدالعزيز البسكرى بوركت وشرفت بمروركم لك كل التحية والتقدير .

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

أخى ياسر فتحى بارك الله فيكم دائما بتنور كتاباتى شرفت بمروركم أستاذى العزيز ياسر خليل تسلم الأيادى ماشى انما الحمد لله ملناش أعادى شرفت بمروركم

بسم الله الرحمن الرحيم والصلاة والسلام على أول الأنبياء وخاتم المرسلين سيدنا محمد ( صلى الله عليه وسلم ) صلاةً الى يوم الدين إخوانى وأحبابى وزملائى وأساتذتى فى منتدانا العريق السلام عليكم ورحمة الله وبركاته أما بعد بدايةً أحب أن أقول لحضراتكم أننى قدمت لكم موضوعاً سابقا بعنوان : إغلاق آلى لملف اكسل إذا ترك بدون استخدام على هذا الرابط : http://www.officena.net/ib/index.php?showtopic=59908 من خلال فكرة هذا الموضوع تم استنباط فكرة تنشيط شاشة الحماية آلياً إذا ترك ملف الاكسل بدون استخدام لمدة زمنية محددة بامكانك تغيير المدة الزمنية فى الكود أى حركة تعملها بالماوس أو الكيبورد تجعل شاشة الحماية غير نشطة . ووضعت لك أسماء شاشات الحماية المتوفرة على ويندوز 7 فى الكود للتبديل بينها .واستدعائها ألياً بعد المدة الزمنية المحددة كما يمكنك استدعاء شاشة الحماية يدوياً بالضغط على المفتاح الاحمر فى الملف . أتمنى أن تسعدوا به لكم منى كل محبة وتقدير واحترام والحمد لله تعالى من قبل ومن بعد *************** Activate the scrensaver.rar

أدرك تماما الهدف من الموضوع ولكن الشىء بالشىء يذكر وأكيد فيه كتير من الناس ما تعرفش يعنى ايه Regedit.exe فالحديث عنه هنا قد يفيد شخص ما يوما ما تقبل تحياتى

الأستاذ نايف السلام عليكم ورحمة الله وبركاته أيه أخبار البرنامج معاك شكلك مبسوط منه بدليل أنك لعبت عليه وكل ملفاتك أصبحت تتكلم ودى حاجة كويسة سيب الملفات تتكلم وتقول رأيها أخى الحبيب : نفذ الخطوات التالية -اقفل الاكسل -فائمة ستارت -اختر الأمر run الامر run يمكن الوصول اليه من لوحة المفاتيح مباشرة زر الويندوز + حرف R اكنب Regedit.exe -اضغط OK -اختر على التوالى HKEY_CURRENT_USER Software Microsoft Office 12.0 أو 14.0 حسب الموجود Excel Options دوبل كليك عليها سوف تظهر نافذة المحرر الخاص بالأوفيس -اضغط"SpeakOnEnter" فى النافذة اليمين مرتين تظهر نافذة غير القيمة التى فيها الى صفر -اقفل محرر الريجسترى افتح أى ملف اكسل مش البرنامج وجرب من جديد نصيحة عليك ببرنامج الدفريز أو التجميد يريحك من حاجات كتير تقبل أسفى على أن برنامجى سبب لك بعض الضيق كل التحية والتقدير لشخصكم الكريم أخوك مختار

أستاذ ماركونى أرفق ملف أفضل من خلال المحرر الكامل مع شرح المطلوب وارفعه الصورة غير واضحة ولا تكفى

جميلة لكن يمكن قطع لسان DNM نهائيا وما يتكلمش أبدا معاك ويحمل لا مؤاخذة زى الــــــــ بالفكرة دى قائمة ستارت RUN اكتب REGEDIT OK YES لفتح محرر الريجسترى HKEY_CURRENT_USER Software DownloadManager دوبل كليك فى النافذة المقابلة نجرى تعديلات دوبل كليك على CheckUpdtVM خلى قيمتها 0 دى تمنع البرنامج من البحث عن تحديتات دوبل كليك على LastCheck فرغ قيمتها نهائيا دى تمنع البرنامج من تسجيل آخر بحث عن تحديتات قفل النوافذ وأعد تشغيل الجهاز أنا عملت كده منذ فترة كبيرة والبرنامج تجريبى ويعمل بكامل صلاحياته ولم يفتح فمه من ساعتها تحياتى

السلام عليكم ورحمة الله وبركاته تفضل أخى الكريم Book222222222.rar

أخى عبد العزيز البسكري بارك الله فيكم وجازاكم خيرا أخى أبو ايمان بارك الله فيكم وجازاكم خيرا ========= أستاذى وأخى ياسر خليل هذا بعض ما عندكم بفضل تشجيعك المستمر وان شاء الله لو اجتهدنا كل واحد فى مجاله الوكالة الدولية للطاقة الذرية هى التى سوف تأتى إلينا متفائل أقوى صح ؟! لكن كلى أمل غداً أو غداً بالنسبة لملف التجميع : لوكان عدد المصنفات الناجمة عن الانشطار أقل من 10 هتلاقى البيانات مظبوطة كما كانت فى ورقة العمل " STARTTING DATA" ولو زادت عن 10 يحدث هذا الاختلاف ليــــــــــــــــــــــــــــــه ؟ لأن أثناء عملية تجميع أوراق العمل من المصنفات المنشطرة فى المجلد OUTPUT ترتب الأوراق حسب الاسم فتلاقى الورقة 1 وبعدها الورقة 10 وبعدها الورقة 2 ثم الورقة 3 ثم .................... الخ وعندما تبدأ عملية تجميع البيانات من هذه الأوراق تبدأ من الورقة 1 ثم من الورقة 10 ثم من الورقة 2 ثم من الورقة 3 وهكذا على التوالى الى أن تنتهى عملية تجميع البيانات بحذف هذه الأوراق باستثناء "FINISHING DATA" تحياتى لك ولكل الزملاء

بسم الله الرحمن الرحيم والصلاة والسلام على أول الأنبياء وخاتم المرسلين سيدنا محمد ( صلى الله عليه وسلم ) صلاةً الى يوم الدين إخوانى وأحبابى وزملائى وأساتذتى فى منتدانا أوفيسنا السلام عليكم ورحمة الله وبركاته أما بعد بداية أوجه شكرى لأستاذى ياسر خليل على موضوعه (الانشطار الكبير .. انشطار أوراق العمل بالمنصف إلى مصنفات مختلفة) في هذا الرابط http://www.officena....showtopic=59788 واليوم أقدم لكم موضوعى الانشطار الأكبر أو the biggest splitting والذى فيه يتم انشطار ورقة عمل واحدة بالمنصف إلى مصنفات متعددة كيفما تشاء حسب اختيارك لعدد الصفوف داخل ورقة العمل فى المصنف الذى سوف ينجم عن عملية الانشطار فكلما قل عدد الصفوف كلما زاد عدد المصنفات الناجمة عن هذه العملية أيضا يمكن تضمين رأس الصفحة ( السطر الأول فى الشيت غالبا ) فى كل المصنفات التاجمة عن هذه العملية والمصنفات الناجمة عن الانشطار تتكون فى مجلد يتم تكوينه أثناء هذه العملية وعلى رأى أستاذى ياسر " اللى يحضر عفريت يصرفه " لذلك لم أنس أن نجمع هذه المصنفات مهما كان عددها فى مصنف واحد وفى ورقة عمل واحدة كما كانت استخدمت فى عملية التجميع كود أستاذنا ياسر خليل بعد اجراء تعديلات تتناسب مع الهدف . الأكواد المستخدمة : الكود الأول المسئول عن عملية الانشطار لــ Jerry Beaucaire : Option Explicit Sub SplitFileByNRows() 'Jerry Beaucaire 7/27/2014 'تعريف المتغيرات فى الكود Dim N As Long, T As Long, LR As Long, Rw As Long, Cnt As Long Dim IncludeTitles As Boolean, fPATHOUT As String, Titles As Range 'تحديد عدد الصفوف التى سوف تنسخ فى كل ملف جديد N = Application.InputBox("How many rows to copy into each new workbook?", "Rows Per", 100, Type:=1) If N = 0 Then Exit Sub ' اذا كانت القيمة = 0 يتم الالغاء ' نحديد تضمين العنوان أو رأس الصفحة فى الملف الجديد أم لا IncludeTitles = MsgBox("Include titles in each new workbook?", vbYesNo) 'تحديد عدد الصفوف التى سوف تنسخ ابتداء من أعلى الصفحة اذا ما تم تضمين العنوان أو راس الصفحة If IncludeTitles Then 'اذا تم تضمين العنوان أو رأس الصفحة Do 'افعل العمل التالى T = Application.InputBox("How many rows from the top makeup the titles to be included in each new workbook?", "Title Rows", 1, Type:=1) 'فرصة اعادة ادخال البيانات اذا تم ادخال 0 أو ضغط الغاء أو تخطى الاجراءات If T = 0 Then If MsgBox("There are no title rows to include after all?" & vbLf & _ "(click YES if made a mistake and would you still like to include title row(s).", vbYesNo) = vbNo Then IncludeTitles = False ' الغاء تضمين العنوان أو رأس الصفحة Exit Do End If Else Exit Do End If Loop End If 'انشاء مجلد جديد فى نفس مسار الملف النشط وذلك لوضع الملفات الجديدة بداخله fPATHOUT = ActiveWorkbook.Path & Application.PathSeparator & "OUTPUT" & Application.PathSeparator If Len(Dir(fPATHOUT, vbDirectory)) = 0 Then On Error Resume Next MkDir fPATHOUT On Error GoTo 0 Else 'فحص الملفات الجديدة داخل المجلد الجديد واعطاء خيار الحذف أو تركها If Len(Dir(fPATHOUT & "*.xl*")) > 0 Then If MsgBox("There are currently files inside the folder:" & vbLf & " " & fPATHOUT & vbLf & vbLf & _ "If we continue, those files will be erased and new files placed in that folder. Are you sure you want to proceed?" _ & vbLf & vbLf & "(Click NO if you want to abort and copy those files to a safe location)", vbYesNo) = vbYes Then Kill (fPATHOUT & "*.xl*") Else Exit Sub End If End If End If 'عملية معالجة الشيت النشط 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False With ActiveSheet If IncludeTitles Then Set Titles = .Range("A1").Resize(T).EntireRow LR = .Range("A" & .Rows.Count).End(xlUp).Row For Rw = T + 1 To LR Step N Cnt = Cnt + 1 'زيادة قيمة المتغير بمقدار 1 Sheets.Add ' اضافة شيت جديد If IncludeTitles Then Titles.Copy Range("A1") .Range("A" & Rw).Resize(N).EntireRow.Copy Range("A" & T + 1) Range("A" & T + 1).Select ActiveWindow.FreezePanes = True Else .Range("A" & Rw).Resize(N).EntireRow.Copy Range("A1") End If ActiveSheet.Move ' تحريك الملف النشط 'حفظ ورقة العمل النشطة باسم كذا وفى نفس المسار ActiveWorkbook.SaveAs fPATHOUT & "NewBook" & Cnt & ".xlsx", 51 ActiveWorkbook.Close False ' الغاء اغلاق الملف النشط Next Rw 'الانتقال للصفوف التالية End With 'تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True MsgBox "A total of " & Cnt & " new workbooks were created and can be found in:" & vbLf & fPATHOUT End Sub الكود الثانى الخاص بعملية التجميع " مقبس من كود التجميع لدى أستاذى ياسر خليل مع اجراء تعديلات واضافات " : Option Explicit Sub CollectWorkbooks() 'تعريف المتغير من النوع نصي Dim Path As String 'تعريف المتغير من النوع نصي Dim Filename As String 'تعريف المتغير من النوع ورقة عمل Dim SH As Worksheet Dim wrkConsSheet As Worksheet Dim lngLastRow As Long Dim lngOutputRow As Long Dim lngMyCounter As Long Dim shp As Shape 'تعريف المتغير للترتيب الصحيح لأوراق العمل Dim X As Long 'تعيين القيمة 1 للمتغير كبداية X = 1 'تعيين المتغير ليساوي مسار المجلد الذي يحوي المصنفات المراد دمج أوراق العمل منها Path = ThisWorkbook.Path & "\OUTPUT\" 'تعيين المتغير ليساوي اسم كل مصنف من المصنفات التي سيتم التعامل معها Filename = Dir(Path & "*.xlsx") 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إلغاء خاصية التنبيه بالرسائل Application.DisplayAlerts = False '[StartingData]حلقة تكرارية لحذف أوراق العمل ما عدا الورقة المسماة For Each SH In ThisWorkbook.Sheets If SH.Name <> "FINISHING DATA" Then SH.Delete Next SH ThisWorkbook.Worksheets("FINISHING DATA").Select Selection.ClearContents 'حلقة تكرارية للمصنفات الموجودة في المسار المحدد إلى أن لا يجد أي مصنف بالمسار Do While Filename <> "" 'فتح المصنف Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 'حلقة تكرارية لكل أوراق العمل داخل المصنف النشط For Each SH In ActiveWorkbook.Sheets 'نسخ ورقة العمل ولصقها بنهاية فهرس أوراق العمل SH.Copy After:=ThisWorkbook.Sheets(X) 'زيادة قيمة المتغير بمقدار 1 X = X + 1 'الانتقال لورقة العمل التالية Next SH 'إغلاق المصنف Workbooks(Filename).Close 'إعادة ضبط المتغير Filename = Dir() Loop 'تنشيط أو تحديد ورقة العمل الأولى Sheets("FINISHING DATA").Activate Application.ScreenUpdating = False Set wrkConsSheet = Sheets("FINISHING DATA") 'اعتبار المتغير wrkConsSheet = ورقة العمل [FINISHING DATA] ' مرحلة البحث والتجميع For Each SH In ThisWorkbook.Sheets If SH.Name <> "FINISHING DATA" Then lngLastRow = SH.Range("A:Z").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row If lngMyCounter = 0 Then SH.Range("A1:Z" & lngLastRow).Copy Destination:=wrkConsSheet.Range("A1") Else lngOutputRow = wrkConsSheet.Range("A:Z").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 SH.Range("A2:Z" & lngLastRow).Copy Destination:=wrkConsSheet.Range("A" & lngOutputRow) End If lngMyCounter = lngMyCounter + 1 'زيادة قيمة المتغير بمقدار 1 End If Next SH Sheets("FINISHING DATA").Activate 'تنشيط أو تحديد ورقة العمل [FINISHING DATA] For Each SH In ThisWorkbook.Sheets If SH.Name <> "FINISHING DATA" Then SH.Delete ' حذف أوراق العمل ما عد الورقة المسماه[FINISHING DATA] Next SH For Each shp In ActiveSheet.Shapes If shp.Top > 150 Then shp.Delete ' لحذف الأشكال التلقائية التى تنسخ أثناء عملية الانشطار والتجميع Next 'تفعيل خاصية التنبيه بالرسائل Application.DisplayAlerts = True 'تفعيل خاصية اهتزاز الشاشة 'Application.ScreenUpdating = True End Sub المرفق يحتوى مصنفين : الأول الذى نجرى عليه عملية الانشطار والثانى وهو الذى تتم فيه عملية التجميع أتمنى أن تسعدوا به و لكم منى كل محبة وتقدير واحترام والحمد لله تعالى من قبل ومن بعد *************** the biggest splitting.rar