نجوم المشاركات

بسم الله ما شاء الله حلول ممتازة أنا كنت مجهز ملفك من بدري لكن حصل انقطاع للكهرباء لمدة ساعتين فمنعت من المشاركة في الموضوع عموماً زيادةً في إثراء الموضوع إليك الملف التالي .. تم الاستعانة بعمودين مساعدين ..عمود لاستخراج القيم الفريدة لأسماء العملاء في العمود I بدايةً من الخلية I4 ، وذلك بناءً على قيمة الخلية K2 ، تم وضع معادلة الصفيف التالية =IFERROR(INDEX($B$4:$B$31,MATCH(0,COUNTIF($I$3:$I3,$B$4:$B$31)+($A$4:$A$31<>$K$2),0),COLUMN(A1)),"") معادلة صفيف تعني أنه بعد الإدخال يتم الضغط على Ctrl + Shift + Enter العمود الثاني المساعد هو العمود J بدايةً من الخلية J4 ، وذلك بناءً على الخليتين K2 وL2 تم استخراج أرقام القيد الغير مكررة بمعادلة الصفيف التالية =IFERROR(IF(I4="","",INDEX($C$4:$C$31,MATCH(0,COUNTIF($J$3:$J3,$C$4:$C$31)+($A$4:$A$31<>$K$2)+($B$4:$B$31<>$L$2),0),COLUMN(A1))),"") معادلة صفيف تعني أنه بعد الإدخال يتم الضغط على Ctrl + Shift + Enter ************************** المرحلة الثانية .. تحديد الخلية L2 ثم الذهاب إلى التبويب Data ثم Data Validation ثم اختيار List من القائمة ثم كتابة المعادلة التالية =OFFSET(I4,0,0,MATCH("",I4:I1000,0)-1,1) نفس الكلام مع الخلية المجاورة M2 =OFFSET(J4,0,0,MATCH("",J4:J1000,0)-1,1) أرجو أن أكون قد وفقت لتوصيل المعلومة تقبل تحياتي Validation Lists YasserKhalil.rar

الحلول المقدمة كلها بالمعادلات .. نسينا الأكواد هذا حل يغنيك عن معادلات الصفيف والمعادلات كلها والأعمدة المساعدة و وو .. وفر حجم ورقة العمل واستمتع بأداء أفضل مع الاكواد Private Sub Worksheet_Change(ByVal Target As Range) Dim A, I As Long If Target.Cells.Count > 1 Then Exit Sub If Target.Value = vbNullString Then Exit Sub If Intersect(Range("I2:J2"), Target) Is Nothing Then Exit Sub A = Range("A4", Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value With CreateObject("Scripting.Dictionary") For I = 1 To UBound(A, 1) If Target.Address = "$I$2" Then If A(I, 1) = Target.Value Then .Item(A(I, 2)) = Empty Else If A(I, 1) = Target(, 0).Value And A(I, 2) = Target.Value Then .Item(A(I, 3)) = Empty End If Next If .Count Then Target.Resize(, 2).Offset(, 1).Validation.Delete Target.Offset(, 1).Validation.Add 3, , , Join(.keys, ",") Application.EnableEvents = False Target.Offset(, 1).ClearContents Application.EnableEvents = True End If End With End Sub أرجو أن يفي بالغرض Validation Lists VBA.rar

السلام عليكم أخى وأستاذى العزيز ياسر لا تتخيل الحر فى اسيوط شديد جدا و مش مخلينى قادر أقعد شوية على الكمبيوتر على العموم ربنا يلطف بالنسبة لاجابة السؤال : Sub OneDimensionalArray5() Dim Arr Arr = Range("A1:A15") Range("k5").Resize(UBound(Arr), 1) = Arr End Sub اضافة متقدمة شوية لكن لم أجد أبسط منها للمشاركة ولكن هتفيدنا قدام شوية عند الحديث عن الثنائية وهى عن حجم المصفوفة : لو عندى مصفوفة أحادية وعايز أعرف حجمها أو ببساطة تتكون من كام عنصر Sub sizeofarray() Dim Arr(1 To 5) As String, x As Integer x = UBound(Arr, 1) - LBound(Arr, 1) + 1 MsgBox " هذه المصفوفة تتكون من " & x & " عنصر " End Sub لو عندى مصفوفة ثنائية وعايز أعرف حجمها الحجم = حاصل ضرب الطرفين Sub sizeofarray2() Dim Arr(1 To 5, 1 To 10) As String, x As Integer, y As Integer x = UBound(Arr, 1) - LBound(Arr, 1) + 1 y = UBound(Arr, 2) - LBound(Arr, 2) + 1 MsgBox " هذه المصفوفة تتكون من " & x * y & " عنصر " End Sub تحياتى لكم

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

السلام عليكم ورحمة الله أخي العزيز، بمعية أعمدة مساعدة ومعادلات تم عمل المطلوب... غير أنه لم تُراعى فيه التكرارات في القوائم المنسدلة (لا في اسم العميل ولا في رقم القيد).... بن علية bjn3000.rar

جرب الخطوات التالية 'Create Calendar On UserForm '--------------------------- '[Additional Controls] قم بإظهار صندوق الأدوات ثم كليك يمين واختر الأمر 'ثم قم برسمها على الفورم [Calendar Control 12.0] اختر الأداة Private Sub UserForm_Activate() 'ضع الكود التالي في حدث تنشيط الفورم ليتم اختيار التاريخ الحالي '-------------------------------------------------------------- Me.Calendar1.Value = Now() End Sub Private Sub Calendar1_Click() 'يقوم الكود بوضع التاريخ الذي يتم تحديده في الخلية النشطة ثم إخفاء الفورم '------------------------------------------------------------------------ ActiveCell.Value = Calendar1.Value UserForm1.Hide End Sub لتطبيق الكلام النظري إليك الملف المرفق Calendar.rar

السلام عليكم ورحمة الله وبركاته رايت هناك حاجة لشرح بعض أدوات الفورم لاخواني بالمنتدي حتي يتمكنوا من معرفة كل اداة ووظيفتها ومثال عليها لكي يتمكنوا من عمل فورم بانفسهم وسوف ابدا خطوة خطوة بشرح كل اداة بمثال عملي الدرس الأول Tree View Control وهي تقوم بعرض البيانات علي صورة شجرة مثال الشرح والتطبيق بالمرفقات TreeViewControl.rar

أخى حسام أولا لو كنت جربت وضع كود فى ملفك المرفق مش هينفع لان امتداده xlsx لو وضعت فيه كود مش هتلاقيه دى حاجة يجب أن تعرفها أولا سيبك من ده وسيبك من الكود يتحط فين وجاوبنى الأول : أنت ملفك المرفق فيه 31 شيت + شيت باسم : متوسط اوزان الشهر هل تريد مسح البيانات من كل الملف ولا من شيتات بعينها وذلك بعد مدة محددة أم تريد حذف شيتات معينة بعد مدة محددة يعنى ما تلاقيش الشيت نهائيا ؟ جاوب وان شاء الله تتحل .

بارك الله فيك يا زيزو يا بسكرى أخبارك وأخبار الحر فى بسكرة تحياتى ليك ولكل أهل الجزائر

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

رائع ومذهل كعادتك دائماً

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

م. ياسر فتحى مرورك دائماًً يسعدنى ويشرفنى جزاك الله خيراً

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

اخينا محمد ومشاركة مع اخي نور الدين عرف ان حقول الجدول لتخزين البيانات الخام ! وانه ليس لوجود الحقل المحسوب مكان في الجدول وكما ذكر اخي نور الدين ! ولكن اتت ميزة جديدة في 2010 وما بعد وهو انه يمكن اجراء العمليات الحسابية في الجدول ولكن العمليات فقط الرياضية البسيطة وكما في سؤالك ! لذلك اليك الطريقة : 1. سيكون عمود ا sel من نوع بيانات محسوب 2. ضع التعبير التالي في خاصية التعبير للحقل المحسوب: [pay]-IIf(IsNull([loan]);0;[loan]) بالتوفيق

بسم الله السلام عليكم ورحمة الله وبركاته أحبابي في الله بفضل الله انتهت التجربة بنجاح في استعمال موقع http://www.batelcosms.com.bh/ لإرسال رسائل sms في دولة البحرين الشقيقة وهي خدمة مدفوعة الأجر تم التوصل لكود يقوم بفتح موقع الشركة وإرسال الرسالة منه باستعمال بيانات المستخدم المزودة من الشركة ووضعها في الكود الكود يحتوي على إجراس الإرسال ودالة لتحويل نص الرسالة للترميز العالمي الموحد utf8 هذا هو الكود لمن يريد إرسال رسائل باستخدام نفس الشركة في الأكسس أو الإكسل Sub sndSMS() customerID = "" UserName = "" userPassword = "" originator = "" MessageType = "ArabicWithArabicNumbers" 'Latin, ArabicWithArabicNumbers, ArabicWithLatinNumbers recipientPhone = "" smsText = "" sURL = "http://www.batelcosms.com.bh/bms/Soap/Messenger.asmx/HTTP_SendSms?customerID=" & customerID & "&userName=" & UserName & "&userPassword=" & userPassword & "&originator=" & originator & "&smsText=" & UTF8Encode(smsText) & "&recipientPhone=" & recipientPhone & "&messageType=" & MessageType & "&defDate=" & Format(Now() - TimeValue("04:00"), "yyyymmddhhnnss") & "&blink=0&flash=0&Private=0" Set oh = CreateObject("Microsoft.XMLHTTP") oh.Open "get", sURL, False oh.send If InStr(oh.responseText, "OK") > 0 Then MsgBox "Message sent." Else MsgBox "Error." End If Set oh = Nothing End Sub Function UTF8Encode(ByVal sStr As String) As String Dim i As Integer Dim thisChar As String Dim sUtf8 As String For i = 1 To Len(sStr) thisChar = AscW(Mid(sStr, i, 1)) If thisChar < 128 Then sUtf8 = sUtf8 + Mid(sStr, i, 1) ElseIf ((thisChar > 127) And (thisChar < 2048)) Then sUtf8 = sUtf8 + Chr(((thisChar \ 64) Or 192)) sUtf8 = sUtf8 + Chr(((thisChar And 63) Or 128)) Else sUtf8 = sUtf8 + Chr(((thisChar \ 144) Or 234)) sUtf8 = sUtf8 + Chr((((thisChar \ 64) And 63) Or 128)) sUtf8 = sUtf8 + Chr(((thisChar And 63) Or 128)) End If Next i UTF8Encode = sUtf8 End Function ومرفق الكود في ملف إكسل وفقنا الله وإياكم لكل ما يحب ويرضى Mas_Send SMS.rar

جاري التواصل مع الحبيب عبد الله (أبو أحمد) بخصوص إرسال رسائل sms من خلال الأكسس وسيتم وضع الكود بعد تجربته ونجاح التجربة بإذن الله

تفضل أخي اجعل التقرير من اليسار الى اليمين جعفر 203.New Microsoft Access Database.accdb.zip

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

الحمد لله عملتها كنت بحاول ولما رجعت لاقيتك كتابلى حاول هههههههههه جزاك الله كل خير ولعلها تكون ما يدور فى خيال السائل بالتوفيق اخى ياسر Countifs1.rar

أخي الحبيب إبراهيم غالباً المشكلة في نسخة الأوفيس .. بس قبل ماتقوم بتنصيب نسخة جديدة جرب الكود التالي أولاً وشوف المشكلة هتتحل ولا لا .. لو متحلتش يبقا شوف نسخة تانية ونصبها Public Sub RenameMSFormsFiles() Const tempFileName As String = "MSForms - Copy.exd" Const msFormsFileName As String = "MSForms.exd" On Error Resume Next RenameFile Environ("TEMP") & "\Excel8.0\" & msFormsFileName, Environ("TEMP") & "\Excel8.0\" & tempFileName RenameFile Environ("TEMP") & "\VBE\" & msFormsFileName, Environ("TEMP") & "\VBE\" & tempFileName MsgBox "Please Restart Excel To Check If ActiveX Controls Are Working Again.", vbInformation End Sub Private Sub RenameFile(fromFilePath As String, toFilePath As String) If CheckFileExist(fromFilePath) Then DeleteFile toFilePath Name fromFilePath As toFilePath End If End Sub Private Function CheckFileExist(path As String) As Boolean CheckFileExist = (Dir(path) <> "") End Function Private Sub DeleteFile(path As String) If CheckFileExist(path) Then SetAttr path, vbNormal Kill path End If End Sub نفذ الماكرو المسمى RenameMSFormsFiles ثم أعد تسغيل برنامج الإكسيل وشوف النتيجة

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

جرب الكود بهذا الشكل Sub AutoFill() With Range("B6", Range("B" & Rows.Count).End(xlUp)) .SpecialCells(2).Offset(, -1).Formula = [C6].Formula End With End Sub

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

ماشاء الله تبارك الله

اخي عصام لم يكن هناك مرفق او صورة للمراجع فهو احتمال كبير انه في المراجع لديك ! عالعموم الحمد لله ولكن لي نصيحة هنا وهي : مالحاجة لوضع متغير من نوع database ك global عارف ايش معنى قلوبال : معناته يظل المتغير حي ومفتوح في الذاكرة طول عمل البرنامج حتى يتم اغلاقه ! وهذا شايفه غير منطقي خصوصا من نوع database ! وشايف في الكود بتاعك شغل محترفين ! وادعو لك بالتوفيق

لكسر ورقة العمل المحمية اخي استخدم الكود التالي 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 افتح ملف الاكسل المطلوب فك حماية صفحاته تحول الى صفحة تحرير الفيجوال VB Editor :Visual Basic Editor او للاختصار alt+F11 ادرج نموزج جديد من قائمة Insert>>>Module - ثم ضع الكود اغلق VB Editor انتقل لصفحة العمل الي حابب تكسرها فعل الماكرو الي عملتوو بتلاقيه بقائمة Tools>>Macro>>Macros وبعدين دبل كليلك على الماكرو الي عملتو بالنسبة للاكسل 2007 بتروح على قائمة View وبتلاقيه اخر اداة على اليمين اختار ماكرو وبعدين اختار الماكرو الي عملتو ودبل كليك ملاحظة : الباسورد الي بتطلع عن طريق هي العملية مو بالضرورة تكون نفس الباسورد الي تم حماية هالصفحة فيها وانما هوو بيخلق باسورد تفك الحماية وهي ناجحة 100%

بعد أذن اخينا الغالي ابو خليل ضع في الاستعلام الشرط التالي Like "*" & نص البحث & "*"

الله عليك ماشاء الله من اين جئت بهذا الصيد الثمين

استبدل الفاصلة في المعادلة بفاصلة منقوطة , ;

ضع المعادلة التالية في الخلية L2 =IF(OR(I2="طنطا - المحلة",I2="مسطرد - جازفيل",I2="القطامية - جازفيل"),SUM(K2*J2*H2,200),SUM(K2*J2*H2))

السلام عليكم وهي مرفق خارج المنتدى على جوجل درايف https://drive.google.com/file/d/0B_ZrhTFFRjn3WU5QRTUzRTdQTkU/view?usp=sharing

مسابقة دينية " من سيربح المليون" جاوب على الاسئلة وافتح الورد لتتعرف على الايات القرانية ولو فيه مشكلة عرفونى لتعديلها حمل من الرابط التالى http://www.mrkzgulf.com/do.php?id=205636 اوحمل من الرابط التالى http://www.mediafire.com/download/uwfanbv4bumanc2/من+سيربح+المليون+مسابقة+دينية.rar

السلام عليكم أختي أم خلود بصراحة أنا لم أجرب هذا الكود ولكن خطر ببالي وممكن أن يساعدك DoCmd.ShowToolbar "ribbon", acToolbarNo DoCmd.ShowToolbar "ضعي اسم القائمة هنا", acToolbarYes الكود الاول يخفي قائمة ملف وأنا متأكد من هذا وآمل أن يكون الثاني يظهر القائمة التي تريدينها والرجاء اعلمينا بالنتيجة بعد التجربة تحياتي لك

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

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

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