lord قام بنشر يناير 22, 2005 قام بنشر يناير 22, 2005 الاخوة الافاضل السلام عليكم ورحمة الله وبركاتة هل يوجد كود اولا: لاظهار صوت معين عند تغير قيمة الخلية مثلا :عندى الخلية x اذا تم تعديلها الى ( ممتاز ) يتم اظهار الصوت ثانيا: عندما تتغير الخلية يتم نســخ بيانات الصف الى ورقة اخرى اسمها (الممتازون ) مثلا وبها جميع بيانات الصف بناء على القيمة الوجودة بالخلية X ( ممتاز ) فقط يوجد مثال شبيه يقوم بنقل الصف ولكن مااريده هو نسخه فى ورقة اخرى ارجو الرد ولكم جزيل الشكر
محمد حجازي قام بنشر يناير 22, 2005 قام بنشر يناير 22, 2005 (معدل) السلام عليكم ... جرب الدالة التالية : Function sound(MyCells As range) If MyCells.Value = "ناجح" Then With Application.Assistant .Visible = True .On = True If Not Sounds Then Sounds = True .Animation = msoAnimationCharacterSuccessMajor End With sound = True Else sound = False End If End Function ولكن انتبه إلى أن المجال الذي يوجد بداخل الدالة لا يصلح إلا لخلية واحدة فقط للأسف لم أجد الاداة Microsoft multimedia control 6.0 في محرر الـ VBA لذلك استعنت بمساعد الأوفيس لإظهار الصوت و القيام بحركة تدل على النجاح Sound.zip تم تعديل يناير 30, 2005 بواسطه محمد حجازي
محمد حجازي قام بنشر يناير 23, 2005 قام بنشر يناير 23, 2005 السلام عليكم ... الكود التالي لدالة وليس لإجراء ، لذلك قم بما يلي : - الصق الكود في الـ Model - اذهب لورقة العمل و اكتب الصيغة التالية : =sound(A1) الخلية A1 مثلاً هي الخلية التي سوف يظهر فيها التقدير (ناجح / راسب) ، وانتبه إلى أن المجال الذي يوجد بداخل الدالة هو لخلية واحدة فقط وبذلك فأنت مضطر إلى إرفاق دالة لكل خلية يجب أن تختبرها (يمكن ذلك عن طريق التعبئة). الدالة السابقة بالإضافة للصوت و الحركة ترجع قيمة True إذا كانت الخلية المختبرة تحتوي على كلمة ناجح وترجع False في عكس ذلك ، ويمكنك إخفاء العامود الذي يحتوي على الدالة مثلاًَ في حال عدم رغبتك بظهور القيمتين True ، False
محمد حجازي قام بنشر يناير 23, 2005 قام بنشر يناير 23, 2005 (معدل) السلام عليكم ... بالنسبة لكود النسخ ، تفضل : Private Sub Worksheet_Change(ByVal Target As range) Dim EndRow As Long If Target.Column = 4 Then If Sheets(1).Cells(Target.Row, Target.Column).Value = "ناجح" Then Sheets(1).Rows(Target.Row).Copy EndRow = Sheets(2).range("A1").CurrentRegion.Rows.Count Sheets(2).Rows(EndRow + 1).Insert Shift:=xlDown Sheets(1).Select End If End If End Sub ولكن يجب عليك الانتباه للملاحظات : - الصق الكود في الورقة الأولى - الكود يقوم بالنسخ من الورقة الأولى في الترتيب إلى الورقة الثانية في الترتيب ، ويمكنك تغيير المصدو و الوجهة بتغيير الترتيب بعد كلمة Sheets - الكود لا يعمل إلا إذا قمت أنت بالتعديل ، أي أن الكود غير صالح في حالات تعديل قيمة الخلية عن طريق دالة معينة تم تعديل يناير 23, 2005 بواسطه محمد حجازي
lord قام بنشر يناير 23, 2005 الكاتب قام بنشر يناير 23, 2005 السلام عليكم ورحمة الله وبركاته شكرا للاستاذ العظيم دلة الصوت عملت وبكفاءة وياريت تعمل على ملف wav سوف تكون رائع وانت رائع بالفعل بالنسبة للنسخ ارجو المحاولة لتعمل عند تغير الخلية بالمعادلة وانا عارف بأن هذا ليس بالصعب على سيادتكم حماك الله ورعاك استاذ استاذ مع رجاء شرح كود النسخ لكى اتعلم شى لاننى مبحبش انقل فقط لك تحياتى control200504@hotmail.com
ابومؤنس قام بنشر يناير 23, 2005 قام بنشر يناير 23, 2005 السلام عليكم ورحمة الله اخي الحبيب محمد هل يعمل الكود الخاص بالصوت علي اصدار محدد من الاوفيس ؟ لانة لم يعلم عندي , حيث ان الاوفيس الموجود عندي هو اوفيس 2000 , ارجو التوضيح وشكرا لك , بالتوفيق ,,,,
محمد حجازي قام بنشر يناير 23, 2005 قام بنشر يناير 23, 2005 السلام عليكم ... الأخ lord : بالنسبة لتشغيل كود النسخ عندما تتغير قيمة الخلية بواسطة صيغة معينة ، لايوجد لدي فكرة محدد عن طريقة عمل ذلك حيث أن الأمر مرتبط بتحديد حدث لهذه الحالة و أنا لا أعرفه ، وفكرت في تحويل إجراء النسخ Sub لدالة Function ولكن وقفت أمام حقيقة مفادها أن الإجراء Function لا ينبغي أن يقوم بإجراء أي تغييرات على البيانات الموجودة داخل مصنف العمل. على أية حال سأبحث عن طريقة لعمل ذلك و أخبرك عندما أجدها. الأخ أبو مؤنس : أنا أستخدم أوفيس 2003 و لا أعلم بالضبط فيما إذا كان هناك إمكانية في الأوفيس 2000 بالتحكم بخصائص مساعد الأوفيس من خلال الكود ، على أية حال يمكنك التحقق من ذلك بالضغط (عندما تكود داخل محرر الفيجوال) على الزر F2 ومن ثم البحث عن كلمة Assistant . بالتوفيق
محمد حجازي قام بنشر يناير 24, 2005 قام بنشر يناير 24, 2005 السلام عليكم ... هذا شرح سريع لكود النسخ : الكود يتفجر عند حدث تعديل الخلية ، حيث يتم إسناد الهدف الذي يمثل الخلية المعدلة في متغير اسمه Target من نوع range. Dim EndRow As Long في السطر السابق عرفنا متغير اسمه EndRow من نوع Long (أي عدد صحيح كبير) ، و الهدف من هذا المتغير هو تخزين عدد أسطر الجدول الموجود في الخلية الثانية. If Target.Column = 4 Then هنا يوجد شرط ، عندما تكود الخلية المعدلة في العامود الرابع تابع وإلا فأنهي الإجراء If Sheets(1).Cells(Target.Row, Target.Column).Value = "ناجح" Then هنا شرط آخر ، إذا كانت الخلية المعدلة تحتوي على كلمة ناجح فتابع و إلا فأنهي الإجراء. Sheets(1).Rows(Target.Row).Copy هنا نسخنا سطر الخلية المعدلة ، بإفتراض أن التعديل يجري في الورقة الأولى. EndRow = Sheets(2).Range("A1").CurrentRegion.Rows.Count هنا أسندنا عدد صفوف الجدول الموجود في الورقة الثانية في المتغير EndRow Sheets(2).Rows(EndRow + 1).Insert Shift:=xlDown هنا أدرجنا السطر المنسوخ في الورقة الثانية ، تحت الجدول القديم. Sheets(1).Select هنا حددنا الورقة الأولى في نهاية العمل. لقد توخيت البساطة بشكل يخدم الشرح أرجو أن أكون وفقت في ذلك
lord قام بنشر يناير 26, 2005 الكاتب قام بنشر يناير 26, 2005 ماشاء الله لقد وفقت فعلا فى توصيل المعلومه كما اريد ويريد الاخرين والتعديل ماشاء الله جميل ارجو منك متابعة هذا الموضوع حتى تصل لحل للصوت wav , وباذن الله ستصل شكرا بالنسبة للاخ ابو مؤنس كود الصوت يعمل فعلا ويعمل على اوفيس 2000 مع اظهار حركة مساعد الاوفيس لكم جميعا الشكر وسوف استكمل معكم باقى ما افعله حتى نصل سويا لعمل رائع
lord قام بنشر يناير 26, 2005 الكاتب قام بنشر يناير 26, 2005 االسلام عليكم ورحمه الله وبركاتة الاستاذ محمد حجازى استكمالا للموضوع يمكن تعديل كود النسخ من أجل نقل جميع الصفوف التي تحقق الشرط دفعة واحدة (بعد الانتهاء من إدخال الدرجات فسوف يكون رائع ارجو الاشارة الى السطر الذى يتغير وسوف اغيره لاننى حاولت ان اغير السطر الخامس واعطيه مدى لنطاق ولم اوفق وفى هذه الحالة سوف يعتمد على مابداخل الخلية ختى ولو معادلة او قيمة مكتوبة لك تحياتى
محمد حجازي قام بنشر يناير 26, 2005 قام بنشر يناير 26, 2005 السلام عليكم ... الموضوع ليس بهذه البساطة يا أخ lord وتعديل الكود يتطلب القيام بمايلي : - تعديل الإجراء السابق إلى روتين فرعي ووضعه في الـ Moudel. - إضافة الحلقة التكرارية For Each من إجل اختبار كل خلية موجودة ضمن المجال الذي يحتوي على خلايا النتيجة (العامود المحدد) ونقل صفها في حال تحقق الشرط. الكود الناتج : Sub CopyRows() Dim EndRow As Long For Each ResultCell In Sheets(1).Columns(4).Cells If ResultCell.Value = "ناجح" Then Sheets(1).Rows(ResultCell.Row).Copy EndRow = Sheets(2).Range("A1").CurrentRegion.Rows.Count Sheets(2).Rows(EndRow + 1).Insert Shift:=xlDown End If Next ResultCell Sheets(1).Select End Sub مع ملاحظة أنك تستطيع تغيير رقم العامود الذي يحتوي على خلايا النتيجة من السطر الثاني في الكود. تحياتي
lord قام بنشر يناير 29, 2005 الكاتب قام بنشر يناير 29, 2005 الف الف شكر للاستاذ محمد حجازى (y) كود جميل جدا بعد التعديل سوف ينفع اعضاء كثيرون جدا جزاك الله خيرا وانا فى انتظار تعديل كود الصوت معلش انا تعبتك
محمد حجازي قام بنشر مارس 4, 2005 قام بنشر مارس 4, 2005 السلام عليكم ... لقد وجدت الحل عن طريق استخدام توابع الـ API. الكود بعد التعديل: Private Declare Function sndPlaySound Lib _ "winmm.dll" Alias "sndPlaySoundA" _ (ByVal lpszSoundName As String, ByVal _ uFlags As Long) As Long Function sound(MyCells As String) Dim MyPath As String If MyCells = "ناجح" Then sound = True MyPath = Workbooks("MyFile.xls").Path & "\SoundFile.wav" sndPlaySound MyPath, &H10 Else sound = False End If End Function بالتوفيق WAV.zip
محمد حجازي قام بنشر مارس 8, 2005 قام بنشر مارس 8, 2005 السلام عليكم ... كما أنه يمكنك الاستعانة بنظام القراءة التلقائية الموجود في الأوفيس : الكود بلفظ عربي: Function sound(MyCells As String) If MyCells = "ناجح" Then sound = True Application.Speech.Speak "muomtaz" Else sound = False End If End Function الكود بلفظ انكليزي: Function sound(MyCells As String) If MyCells = "ناجح" Then sound = True Application.Speech.Speak "excellent" Else sound = False End If End Function
الردود الموصى بها