إبراهيم محمد

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

الاخ الفاضل / عبد السلام زاوي جزاك الله خيرا وشكرا لمرورك الكريم وكلماتك الطيبه

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

Dim US As String US = Environ("UserName") MsgBox US السلام عليكم ورحمه الله وبركاته اليكم هذا الكود المختصر فى معرفه اسم المستخدم للجهاز ويمكن استخدامه لتحديد صلاحيات الملف تلقائيا بمجرد ان يتم تشغيله من جهاز الى اخر او يمكن استخدامه كما تشاء وطبعا هذا لا شىء فى بحر علم الاستاذة الكرام ولكنها نقطه وجدتها واحببت ان يستفيد منها الجميع

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

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

الاستاذ الفاضل / بن عليه حاجي لك خالص الشكر والتقدير على اهتمامك وردك على الموضوع وانا حملت الملف ولكن عند تجربته طلع رقم خطاء اخر وهو 1004 وفى الحقيقه مع بعض البحث تبين ان الخطاء رقم 9 من اسبابه ان المتغير fname يحتفظ بالمسار كاملا للاسم والامر close يريد الاسم فقط دون باقى المسار ومن هنا تاتى هذة الرساله وقد قمت وبمعاونه احد الاصدقاء باعادة صياغه الكود مع فصل الاسم عن باقى المسار قبل امر الاغلاق وقد نجحت التجربه ويهمنى تقيمك ونصحك الكريم لهذا الامر وجزاك الله كل خير وفى انتظار ردك الكريم Option Explicit Sub get_sheets_Path() Dim i As Integer Dim objfl As Variant Dim sFileName As String Application.DisplayAlerts = False ' áÊÚØíá ÑÓÇÆá ÇáÊÍÐíÑ Application.ScreenUpdating = False Dim MyDialg As FileDialog, sspath As String, Filename As String, sheet As Worksheet 'On Error GoTo Err_Test_MyPath '========================================== Set MyDialg = Application.FileDialog(msoFileDialogFilePicker) '========================================== 1: With MyDialg .ButtonName = "Select" .AllowMultiSelect = True .Filters.Add "Excel Files", "*.xls;*.xlsx;*.xlsm", 1 .Title = "ÇÎÊíÇÑ ÇáãáÝÇÊ ÇáãØáæ È ÇÖÇÝå ÕÝÍÇÊåÇ " .InitialView = msoFileDialogViewDetails .InitialFileName = ActiveWorkbook.Path & "\" .Show For Each objfl In .SelectedItems Filename = objfl If Filename <> ThisWorkbook.Name Then Workbooks.Open Filename:=Filename, ReadOnly:=True For Each sheet In ActiveWorkbook.Sheets sheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'after last sheet Next sheet sFileName = Split(Filename, "\")(UBound(Split(Filename, "\"))) Workbooks(sFileName).Close End If Next objfl On Error GoTo 0 End With Set MyDialg = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox " Êã ÊÍãíá ÌãíÚ ÇáÕÝÍÇÊ ÇáÊì ÈÇáãáÝÇÊ ÈäÌÇÍ " End Sub

الاستاذ الفاضل / بن عليه حاجي بارك الله فيك وزادك الله علما ومعذرة لدخولي على الموضوع هكذا دون استأذان فما اردت الا اثراء الموضوع بتعدد الافكار ومنكم نتعلم المزيد تقبل تحياتي واخترامي

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

بسم الله الرحمن الرحيم الاستاذة الافاضل المحترمين مرفق كود يقوم بجلب صفحات من ملفات متعددة الى ملف العمل وتمكن المشكله عندم تصل الى مرحله الملف غلق الملف الذى تم النسخ منه فانه يعطى run time error 9 وقد حاولت كثيرا فى تغير اسماء المتغيرات وتوحيدها ولكن دون جدوى ولا اعرف ما السبب Option Explicit Sub get_sheets_Path() Application.DisplayAlerts = False Application.ScreenUpdating = False Dim MyDialg As FileDialog, sspath As String, Fname As String, sheet As Worksheet, FileChosen As Integer, i As Integer On Error GoTo Err_Test_MyPath '========================================== Set MyDialg = Application.FileDialog(msoFileDialogFilePicker) '========================================== 1: With MyDialg .AllowMultiSelect = True .Title = "احضار ملفات " .InitialFileName = ActiveWorkbook.Path & "\" .Filters.Add "Excel File", "*.xls ; *.xlsx ; *.xlsm", 1 .InitialView = msoFileDialogViewList FileChosen = .Show End With '========================================== If MyDialg.SelectedItems.Count Then sspath = MyDialg.SelectedItems(1) '& Application.PathSeparator If Dir(sspath, vbDirectory) = vbNullString Then MsgBox " : لم يتم اختيار مسار صحيح " & vbCr & vbCr & sspath _ & vbCr & vbCr & "يجب اختيار مسار صحيح ", 524288, "مسار خاطىء" GoTo 1 Else ' الكود بالاعلى من كتابه الاستاذ العلامه / عبد الله باقشير If FileChosen = -1 Then For i = 1 To MyDialg.SelectedItems.Count Workbooks.Open MyDialg.SelectedItems(i), , ReadOnly:=True Fname = MyDialg.SelectedItems(i) ActiveWorkbook.Sheets.Select Sheets.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'after last sheet '----------------------------------------------- Workbooks(Fname).Close True ' عندما يصل الكود الى هنا يعطى الخطاء '------------------------------------------------- Next i End If Application.DisplayAlerts = True MsgBox " تم تحميل جميع الصفحات بنجاح " End If End If '========================================== Err_Test_MyPath: If Err Then MsgBox "Err.Number:" & vbCr & Err.Number Set MyDialg = Nothing End Sub

واليك المرفق ترتيب المحطات.rar

السلام عليكم ورحمه الله وبركاته جرب وضع هذا الكود فى نهايه الكود عند الكود الذى يقوم بتفعيل الحمايه على الصفحه وان شاء الله يكون به ما تطلب ActiveSheet.Protect (123), DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowSorting:=True, AllowFiltering:=True

تفضل اخي المرفق كلمه السر للحمايه هى 123 ترتيب المحطات.rar

ما شاء الله استاذنا وعالمنا الجليل الاستاذ الفاضل / عبد الله باقشير والله كود فى منتهى الروعه وينم عن احتراف وتمكن وبالفعل كود نتعلم منه الكثير جزاك الله خيرا وبارك الله فيك وجعلك الله دائما نبراسا للعلم نقتدى ونهتدي بها ونتعلم منك دائما المزيد باذن الله تعالى خالص تحياتى وتقديرى واحترامي

الاخ العزيز / ابو حكيم اتمنى لك التوفيق وبارك الله فيك ولا داعي يا اخي الحبيب للاعتذار فليس بين الاخوة والاصدقاء هذا تقبل تحياتي وتقديري

السلام عليكم ورحمه الله وبركاته مرفق الكود التالى والذى يقوم باعطاءا لمستخدم اختيار ملف معين بحيث يتم تخزين مسار هذا الملف فى مسار والتعامل معه بعد ذلك لتخزيم ملفات فيه ولكن تكمن المشكله فى احتمالات الخطاء منها اذا لم يختار المستخدم مسار وضغط على زر الالغاء او اذا كان الملف الذى يتم حفظه فى نفس المسار له نفس الاسم واختار المستخدم عدم الحفظ لا ادرى هل وضحت الفكرة ام لا ولكن اى استفسار اخر ان شاء الله نوضح المشكله فيه وبارك الله فيكم ايها الاستاذة الاجلاء واثابكم الله خير Sub get_folder_path() Dim iipath As String With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show iipath = .SelectedItems(1) End With End Sub

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

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

معذرة رابط الموضوع http://www.officena.net/ib/index.php?showtopic=45248

الاخ العزيز / ابو حكيم قم باضافه ميديول جديد عن طريق شاشه الفيجوال البيزيك وانت واقف على اى ميديول ثم انقر بالماوس الايمين واختار ادخال ميديول ثم قم بلصق الكود التالى فيه وقم بالحفظ وسوف يعمل الكود بشكل تلقائى علما بان برنامج صلاحيات المستخدمين يوجد اكثر من اصدار له ويمكنك تصفح الرابط التالى سوف تجد اكثر من مرفق خلال المشاركات فى الموضوع حسب طلبات الاعضاء http://www.officena.net/ib/index.php?showtopic=45248 'åÐÇ ÇáßæÏ ááÊÛáÈ Úáì ãÔßáå ãÓÊæì ÇáÇãÇä ááãÇßÑæ æÇÌÈÇÑ ÇáãÓÊÎÏã Úáì ÊÎÝíÖ ãÓÊæì ÇáÇãÇä ÚäÏ ÊÔÛíá ' åÐÇ ÇáÈÑäÇãÌ Public xx As Integer Public x As Integer Sub Auto_Open() kh_wVisible True UserForm1.Show End Sub Sub Auto_Close() Dim i As Integer kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) End Sub Sub kh_wVisible(ibol As Boolean) Dim nBook As String nBook = ThisWorkbook.Name With Windows(nBook) If .Visible = Not ibol Then .Visible = ibol End With End Sub

الاستاذ الفاضل / مجدى يونس شكرا لمرورك الكريم وكلماتك الطيبه

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

السلام عليكم ورجمه الله وبركاته مرفق ملف به نموذج يتم من خلاله تحديد الصفحات المراد حذفها نهائيا من الملف ارجو ان يكون مفيد هذا وبالله التوفيق dell_sheets.rar

الاخ العزيز / قصى شكرا لمرورك الكريم وكلماتك الطيبه

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