إبراهيم ابوليله

اخى مختار فعلا فكره جميله وكود اجمل تقبل تحياتى

اخى مختار انا جرب ده كله من البدايه بس الشئ الى خالانى اصر على رفع الموضوع هو انه اشمعن ياعنى مع الليبل بيحصل الخطأ ولو استدعينا الفورم 2 مش هيحصل خطأ ولو استخدمنا الكود بدون فورم بردو مفيش خطأ على العموم مشكور اخى على الاراء الجميله دى تقبل تحياتى

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

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

اخى مختار الكود يقف على الخطأ الاتى

اخى مختار ممكن ترفق الكود كاملا

اخى مختار منور والله بس انا شايف ان الخطأ ملوش دعوه بالاغلاق وانا اكتشفت ان الحل فى حاجتين الاول حزف السطر ده If Len(Worksheets(name.Value).name) = 0 Then الثانى جرب استدعاء الفورم الثانى عن طريق زر بدى من الليبل فى انتظار مزيد من الاراء تقبل تحياتى

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

اخى محمد جرب هذا SH.UNPROTECT

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

اخى خالد جرب الكود الاتى On Error Resume Next del = Application.GetOpenFilename("Excel Files (*.xls), *.xls,(*.xlsm), *.xlsm") Kill (del)

ماشى ياعم ياسر خلينا معاك للاخر بس بالله عليك اهم حاجه خلى بالك من الامتدادات xlsm---xlsb وعلى فكره انت ناصح ودى حاجه احنا كلنا متأكدين منها ليه بقى علشان انت عارف ان الملف مش بيفك xlsm والا مكنتش رفعت الملف بالامتداد ده ياريس على العموم فى طلب تانى ياكبير ......................................... عايزين البرنامج يكون اشمل من كده شويه ويفك الملفات المحميه من الخارج يابقى ورينا الهمه يابوب تقبل تحياتى

Sub PasswordBreaker() ' ßæÏ Ýß ÍãÇíå ÇáæÑÞå Dim i As Integer, j As Integer, k As Integer Dim l As Integer, m As Integer, n As Integer Dim i1 As Integer, i2 As Integer, i3 As Integer Dim i4 As Integer, i5 As Integer, i6 As Integer On Error Resume Next For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If ActiveSheet.ProtectContents = False Then MsgBox "One usable password is " & Chr(i) & Chr(j) & _ Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ActiveWorkbook.Sheets(1).Select Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _ Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Exit Sub End If Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next End Sub اخى ياسر مشكورا على البرنامج الجميل ده ولكن كما قال استاذنا ياسر الاهم هو فك حماية vba للامتدادات الاخرى لانك ببساطه لو فكيت حماية vba لاى ملف يمكنك ساعتها استخدام الكود الاتى لفك حماية اوراق العمل

اخى ياسر ايه الجمال والحلاوه دى كود جميل وبسيط ولكن هل يمكن تعديل الكود ليقوم بترحيل نطاق من البيانات بحيث يكون النطاق ديناميكى تقبل تحياتى

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

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

اخى عبد العزيز ممكن تحاول تضغط الجزء ده على ما اعتقد ان الضغط ممكن يقلل شويه من الحجم تققبل تحياتى

اخى عبد العزيز انا كمان فى انتظار النسخه بفارغ الصبر تقبل تحياتى

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

اخى نايف يرجى الالتزام بتوفير الوقت والجهد على الاخوه الاعضاء عن طريق ارفاق ملف للعمل عليه كما قال استاذنا الفاضل ياسر ...................................... لارفاق ملف الى المشاركه فقط قم بضغط ملف الاكسيل ببرنامج وينرار ثم قم بسحب الملف المضغوط الى المشاركه ....................................................................... وتفضل محاوله منى على حسب فهمى للموضوع Private Sub CommandButton3_Click() 'CE?E Dim WR As Workbook Dim sh As Worksheet Set WR = "20150817" Set sh = WR.Sheets("price1") If OptionButton1 = True Then With sh Dim LastRow As Integer, r As Integer, t As Integer ListBox1.Clear LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row For r = 2 To LastRow If .Cells(r, 3) Like "*" & TextBox1.Text & "*" Then ListBox1.AddItem ListBox1.List(t, 0) = .Cells(r, 3) ListBox1.List(t, 1) = .Cells(r, 6) t = t + 1 End If Next End With End If End Sub تقبل تحياتى

اخى الفاضل اولا لك منى دعوه طيبه للالتزام بقواعد المنتدى ومنها ان تكون اسماء الظهور باللغه العربيه .............................................................. ثانيا هذه محاوله بسيطه منى ارجو ان تفى بالغرض تقبل تحياتى Private Sub CommandButton2_Click() Application.Visible = True searchE.Hide End Sub Private Sub CommandButton4_Click() Me.PrintForm End Sub Private Sub CommandButton5_Click() searchE.Hide Main.Show End Sub Private Sub Label5_Click() End Sub Private Sub OptionButton1_Click() OptionChange (1) End Sub Private Sub OptionButton2_Click() OptionChange (2) End Sub Private Sub OptionButton3_Click() OptionChange (3) End Sub Sub OptionChange(myOption As Long) Me.ComboBox2.Clear For h = 2 To 9 Me.Controls("textbox" & h).Value = "" Next Select Case myOption Case 1 With Sheets("qs") .Select ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Case 2 With Sheets("q") .Select ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "C").End(xlUp).Row).Value End With Case 3 With Sheets("gar") .Select ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Case 4 With Sheets("dok") .Select ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Case 5 With Sheets("harrr") .Select ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Case 6 With Sheets("owww") .Select ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Case 7 With Sheets("baaaa") ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Case 8 With Sheets("bbbbb") ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Case 9 With Sheets("qqqq") .Select ComboBox2.List = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With End Select End Sub Private Sub OptionButton4_Click() OptionChange (4) End Sub Private Sub OptionButton5_Click() OptionChange (5) End Sub Private Sub OptionButton6_Click() OptionChange (6) End Sub Private Sub OptionButton7_Click() OptionChange (7) End Sub Private Sub OptionButton8_Click() OptionChange (8) End Sub Private Sub OptionButton9_Click() OptionChange (9) End Sub Private Sub TextBox8_Change() TextBox8.Value = Format(TextBox8.Value, "yyyy/mm/dd") End Sub Private Sub TextBox9_Change() TextBox9.Value = Format(TextBox9.Value, "yyyy/mm/dd") End Sub Private Sub ComboBox2_Change() On Error Resume Next If ComboBox2.MatchFound = False Then MsgBox "ÝÖáÇ ÇÎÊÑ ãä ÇáÞÇÆãå": Exit Sub lr = Cells(Rows.Count, "A").End(xlUp).Row Dim a As Range Set ww = Application.WorksheetFunction Set a = Range("A2:z" & lr) Me.TextBox2.Value = ww.VLookup(Me.ComboBox2.Value, a, 2, False) Me.TextBox3.Value = ww.VLookup(Me.ComboBox2.Value, a, 3, False) 'Me.TextBox4.Value = ww.VLookup(Me.ComboBox2.Value, a, 4, False) Me.TextBox5.Value = ww.VLookup(Me.ComboBox2.Value, a, 4, False) Me.TextBox6.Value = ww.VLookup(Me.ComboBox2.Value, a, 8, False) Me.TextBox7.Value = ww.VLookup(Me.ComboBox2.Value, a, 9, False) Me.TextBox8.Value = ww.VLookup(Me.ComboBox2.Value, a, 6, False) Me.TextBox9.Value = ww.VLookup(Me.ComboBox2.Value, a, 7, False) End Sub Private Sub UserForm_Click() End Sub

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

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

انا فكيت الضغط وحطيتها فى سيستم32 وتم تشغيل الاداه واضافتها لملفات الويندوز وتم تشغيل الاداه كسئول وماذال نفس الخطأ موجود

اخى ياسر خطأ فى الاسكن ويندوز 7