يوسف عطا

بعد إذن أخى جمال بك دغيدى ولإثراء الموضوع بقترح الكود التالى لنسخ النتيجة مع فرزها لشيت الكل مع الإستغناء عن ماكرو معادلة إف فى الشيت الرئيسى يراعى تسمية الشيت الرئيسى (الشيت) قبل تنفيذ الكود Sub فرزص() Sheets("الشيت").Select Range("A11:DO10000").Select Selection.Copy Sheets("الكل").Select Range("A11").Select ActiveSheet.Paste Range("DO11").Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-1]="""","""",IF(RC[-1]=""ناجح"",1,IF(RC[-1]=""راسب"",2,IF(RC[-1]=""غائب"",3))))" Range("DO11").Select Selection.AutoFill Destination:=Range("DO11:DO10000") Range("A11:DO10000").Select Selection.Sort Key1:=Range("DO11"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal MsgBox "تم نسخ النتيجة وترتيبها فى شيت الكل" End Sub

أولاً تضع الكود فى موديول ثانياً تصنع زر لإستدعاء الكود بمجرد كبس هذا الزر تظهر لك نتيجة الكود الملف مرفق إستخراج رقم الهارد ديسك.rar

عمل رائع من أستاذ أروع نسأل الله أن يجعل ل أعمالك في موازين حسناتك

حسناً يا أخوتى الأعزاء بعد أن توصلنا لمعرفة رقم الهارد الحقيقى الثابت وبأكثر من طريقة ومرفق طريقة أخرى نتيجتها تظهر عن طريق رسالة داخل ويندو وهى من الأخ حامد فله الشكر Sub test() Dim s As String With GetObject("winmgmts:\\.\root\CIMV2") For Each itm In .ExecQuery("SELECT * FROM Win32_DiskDrive", , 48) s = s & "SerialNumber: " & itm.SerialNumber & vbCrLf s = s & "Model: " & itm.Model Next itm End With MsgBox s End Sub الآن نأتى للهدف الرئيسى من الموضوع وهو ربط الملف برقم الهارد لكى لا يفتح إلا على جهاز أو أجهزة محددة أتوقع أو أتصور أن يكون الأمر كذلك 1. إستخدام هذا الكود Function GetPhysicalSerial() As Variant Dim obj As Object Dim WMI As Object Dim SNList() As String, i As Long, Count As Long Set WMI = GetObject("WinMgmts:") For Each obj In WMI.InstancesOf("Win32_PhysicalMedia") If obj.SerialNumber <> "" Then Count = Count + 1 Next ReDim SNList(1 To Count, 1 To 1) i = 1 For Each obj In WMI.InstancesOf("Win32_PhysicalMedia") SNList(i, 1) = obj.SerialNumber i = i + 1 If i > Count Then Exit For Next GetPhysicalSerial = SNList End Function 2. وضع المعادلة فى بعض الخلايا بأحد شيتات الملف مع إخفاء هذا الشيت 3. يصمم الكود بطريقة معادلة إف بالبلدى كدة إذا كان الرقم فى خلية المعادلة متطابق مع الرقم أو أحد الأرقام الموجودة فى الكود ( مفروض أنها أرقام الهاردات التى مسموح فتح الملف بها) تظهر رسالة تفيد أنه جارى فتح الملف مع زر أوك وإن لم يتطابق الرقم فى المعادلة مع أحد الأرقام بالكود تظهر رسالة أن هذا الملف محظور فتحه على هذا الجهاز مع زر خروج ما رايكم فى هذا السيناريو للكود المطلوب علماً بأن رقم الهارد الذى يظهر فى الخلية التى بها المعادلة مفروض أن يتم تحديثه مع فتح الملف تلقائياً وقبل أن يعمل الكود ولكنه حتى الآن ومع الأسف لا يتم تحديثه إلا بعد ضغط إنتر فى الخلية الموجودة فيها المعادلة وفى إنتظار الحلول من الأعضاء المحترمين

بالفعل إستخرج الكود الأخير نفس رقم الكود السابق وليس فقط سيريال الهارد بل ايضاً سعته وموديله ونوع كابل الربط مع البوردة مشكور حامد بك يونس وهذا يعود بنا يا أستاذ دغيدى للموضوع الآخر بخصوص إستخدام رقم الهارد فى كود لعدم فتح الملف إلا على جهاز أو أجهزة معينة فالرجاء من سيادتكم ضم هذا الموضوع مع ذلك ومرفق لينك الموضوع الآخر ليكون الموضوع متكامل http://www.officena.net/ib/index.php?showtopic=43800 وسواء دمج هذا بذال أو ذاك بهذا فالأمر سيان خاصة وأن معظم الردود بالموضوعين لنفس الأعضاء

إخوتى الأعزاء قمت بتجربتين لمحاولة الوصول لرقم الهارد ديسك الحقيقى الثابت عن طريق كودين مختلفين وكل كود أعطانى نتيجة مختلفة الكود الأول يجب عمل التالى 1. نسخ الكود المرفق فى موديول Function GetPhysicalSerial() As Variant Dim obj As Object Dim WMI As Object Dim SNList() As String, i As Long, Count As Long Set WMI = GetObject("WinMgmts:") For Each obj In WMI.InstancesOf("Win32_PhysicalMedia") If obj.SerialNumber <> "" Then Count = Count + 1 Next ReDim SNList(1 To Count, 1 To 1) i = 1 For Each obj In WMI.InstancesOf("Win32_PhysicalMedia") SNList(i, 1) = obj.SerialNumber i = i + 1 If i > Count Then Exit For Next GetPhysicalSerial = SNList End Function 2. كتابة المعادلة التالية فى الخلية المراد إظهار رقم الهارد ديسك فيها =GetPhysicalSerial() ستجد رقم الهارد ديسك فى كل خلية تكتب فيها هذه المعادلة الكود الثانى الذى أخبرنا عنه أخونا جمال بك دغيدى فى مشاركته بالأعلى وبنفس الطريقة 1. نسخ الكود فى موديول Function HDSerialNumber() As String Dim fsObj As Object Dim drv As Object Set fsObj = CreateObject("Scripting.FileSystemObject") Set drv = fsObj.Drives("C") HDSerialNumber = Left(Hex(drv.SerialNumber), 4) _ & "-" & Right(Hex(drv.SerialNumber), 4) End Function 2. كتابة المعادلة التالية فى الخلية المراد إظهار رقم الهارد ديسك فيها =HDSerialNumber() وسنجد رقم الهارد ديسك فى كل خلية نكتب فيها تلك المعادلة وبتجربة الكودين أعطيانى نتيجتين مختلفتين كما يلى 12B1-CF33 أعطتنى هذا الرقم HDSerialNumber WD-WMAVU2718655 أعطتنى هذا الرقم GetPhysicalSerial والآن لدينا مشكلتين 1. كيف نتأكد من رقم الهارد الثابت الأصلى الذى لا يتغير هل هو ما جلبه لنا الكود الأول أم ما جلبه لنا الكود الثانى ؟؟ 2. كيف نستخدم رقم الهارد (إذا تأكدنا منه) فى تأمين ملف الغيكسيل بحيث لا يفتح إلا فقط فى الجهاز أو الأجهزة التى نحددها عن طريق رقم الهارد ديسك وفى هذا فليدلى ذوى الخبرة كل منهم بدلوه فى هذا الموضوع

إخوتى الأعزاء يجب عمل التالى 1. نسخ الكود المرفق فى موديول Function GetPhysicalSerial() As Variant Dim obj As Object Dim WMI As Object Dim SNList() As String, i As Long, Count As Long Set WMI = GetObject("WinMgmts:") For Each obj In WMI.InstancesOf("Win32_PhysicalMedia") If obj.SerialNumber <> "" Then Count = Count + 1 Next ReDim SNList(1 To Count, 1 To 1) i = 1 For Each obj In WMI.InstancesOf("Win32_PhysicalMedia") SNList(i, 1) = obj.SerialNumber i = i + 1 If i > Count Then Exit For Next GetPhysicalSerial = SNList End Function 2. كتابة المعادلة التالية فى الخلية المراد إظهار رقم الهارد ديسك فيها =GetPhysicalSerial() ستجد رقم الهارد ديسك فى كل خلية تكتب فيها هذه المعادلة والسؤال الآن كيف نتأكد من أن هذا الرقم هو رقم الهارد نفسه الثابت الذى لا يتغير وليس رقم الهارد أو البارتشن المتغير مع كل فورمات يجب أن يقوم أحد بتجربة الكود والإحتفاظ بالرقم ثم مقارنته بعد الفورمات ولكن من الصعب أن نقوم بعملية فورمات لمجرد التأكد من صحة كود لذلك فلنترك الأمر للزمن ومن تجبره الظروف أن يقوم بالفورمات ربما سيكون هو من يؤكد لنا مدى صحة الرقم المستخرج من الكود لكم تحياتى

بعد عدة تجارب أعطانى هذا الرقم هل هذا هو رقم الهارد وكيف أتأكد من الرقم ؟؟ WD-WMAVU2718655

أخى دغيدى أعمل كذلك على ويندوز 8 حالياً وأوفيس 2003 و 2010 وكلاهما عربى ولكنها تعطى خطأ ماذا أفعل

لا أعرف لماذا يعمل الكود جيداً فى حالة التجربة فى ملف جديد ولكن عند إضافته للملف المطلوب العمل عليه لا يعمل جارى محاولة معرفة السبب وإخباركم بالنتيجة

بحق يا الغالى تسلم إيدك وللعلم فالكود يعمل حتى لو كانت الخلايا المطلوب تلوينها بها معادلات سواء معادلات مباشرة أو معادلات من أوراق أخرى بحق الله ينور على معاليكم

أفكارك عظيمة أخى الخالدى جارى التجربة

حتى الكود ده من الموقع الذى أشار له أخى جمال بك دغيدى لم ينفع معى Function HDSerialNumber() As String Dim fsObj As Object Dim drv As Object Set fsObj = CreateObject("Scripting.FileSystemObject") Set drv = fsObj.Drives("C") HDSerialNumber = Left(Hex(drv.SerialNumber), 4) _ & "-" & Right(Hex(drv.SerialNumber), 4) End Function

للأسف لم تعمل معى الخيارات السابقة

بالفعل لم أستطع تنفيذ المطلوب على ويندوز 7

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

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

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

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

مشكور ابو نصار جارى التجربة

للاسف فشلت فى تقسيم الكود بالطريقتين الأولى عن طريق تقسيم الأعمدة بأكثر من متغير الثانية عن طريق تكرار لعدة أكواد الكود ليعمل فى كل كود على عدة أعمدة الرجاء المساعدة فى هذا الأمر ومرة أخرى هذه هى الأعمدة المراد التطبيق عليها ("K11:K2000,L11:L2000,O11:O2000,P11:P2000,Q11:Q2000,R11:R2000,V11:V2000,W11:W2000,Z11:Z2000,AA11:AA2000 AB11:AB2000,AC11:AC2000,AG11:AG2000,AH11:AH2000,AK11:AK2000,AL11:AL2000,AM11:AM2000,AN11:AN2000,AS11:AS2000,AT11:AT2000,AY11:AY2000,AZ11:AZ2000 BA11:BA2000,BB11:BB2000,BG11:BG2000,BH11:BH2000,BM11:BM2000,BN11:BN2000,BO11:BO2000,BP11:BP2000,BT11:BT2000,BU11:BU2000,BX11:BX2000,BY11:BY2000,BZ11:BZ2000 CA11:CA2000,CF11:CF2000,CG11:CG2000,CL11:CL2000,CM11:CM2000,CN11:CN2000,CO11:CO2000,CQ11:CQ2000,CR11:CR2000,CS11:CS2000,CT11:CT2000,CU11:CU2000,CV11:CV2000,CW11:CW2000,CX11:CX2000,CY11:CY2000,CZ11:CZ2000 DA11:DA2000,DC11:DC2000,DG11:DG2000,DH11:DH2000,DK11:DK2000,DL11:DL2000,DM11:DM2000,DN11:DN2000,DR11:DR2000,DS11:DS2000,DV11:DV2000,DW11:DW2000,DX11:DX2000,DY11:DY2000")

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

طالما الأمر كذلك فأرى أن يتم عمل شيت كنترول خاص لكل شعبة أو بالأحرى هو نسختان من نفس الشيت مع فارق بسيط فى تسمية المواد الخاصة بكل شعبة المطلوب للبدء 1. عدد الطلبة فى كل شعبة 2. المواد المقررة لكل شعبة 3. الدرجات الكبرى والصغرى لكل مادة ولكل فرعياتها أو إمتحاناتها 4. يكون من الأفضل إرفاق شيت إيكسيل يكون نسخة من الشيت الورقى ولو ليك تصور معين تفضل

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

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