نجوم المشاركات
Popular Content
Showing content with the highest reputation on 10/03/15 in مشاركات
-
الحمد لله رب العالمين و بفضل من الله ثم رضا الوالدين و بفضل هذا المنتدى و المنتديات العربية و العالمية الأخرى المتخصصة في مجال الإكسيل, حصلت على شهادة MVP Most Valuable Professional و لله الحمد أني كا أول عربي حصل عليها و أسأل الله العلي القدير أن تكون بداية توفيق جديد لنا و أنا نخدم الأمة و أن ننفع بها أهلنا و أمتنا لله الحمد من قبل و من بعد4 points
-
ماشاء الله عليك استاذ ياسر والى الامام جميل جدا فكرتك استاذ سليم هذه محاولة بسيطة وللاثراء والافادة ! ومغازلة الكبار! Function ramhan(xinput As String) As Integer xinput = Replace(xinput, "أ", "ا") xinput = Replace(xinput, "إ", "ا") xinput = Replace(xinput, "ة", "ه") Dim xletters As String, i As Integer, xsum As Integer xletters = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي" For i = 1 To Len(xinput) xsum = xsum + InStr(1, xletters, mid(xinput, i, 1)) Next i ramhan = xsum End Function تحياتي للجميع4 points
-
السلام عليكم ورحمة الله وبركاته وبعد ,,, أقدم لكم اخوتى الأفاضل كودا يقوم بفحص نطاق من الخلايا ويحدد فقط الخلايا التى تحوى معادلات ذات القيم الخاطئة ويميزها بالتلوين أو التعديل أو التفريغ أو بعمل فلاش لتلك الخلايا لك الخيار فى اختيار شكل التمييز المناسب الكود وعليه شرح بعض السطور : Option Explicit Private Declare Function sndPlaySound32 Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName _ As String, ByVal uFlags As Long) As Long Sub CheckRangeForError() ' by mokhtat 2/10/2015 ' Error values include #DIV/0!, #N/A, #NAME?, #NULL!, #NUM!, #REF!, and #VALUE!. Dim C As Range Dim i As Integer Dim PlaySound As Boolean ' تحديد نطاق الفحص Sheets("Sheet1").Range("A2:F20").Select ' تحديد الخلايا التى تتضمن أخطاء Selection.SpecialCells(xlCellTypeFormulas, 16).Select ' استدعاء صوت من أصوات الويندوز للتنبيه على انتهاء الفحص PlaySound = True If PlaySound Then Call sndPlaySound32("C:\windows\media\notify.wav", 1) ' حدد الصوت المفضل لك طبقاً للمسار المقابل End If ' رسالة الى المستخدم بسؤال عن الرغبة فى التمييز أم لا If MsgBox(" تم انتهاء الفحص , هل تريد تمييز الخلايا ؟ ", vbYesNo + vbQuestion) = vbNo Then Exit Sub ' فى حالة اختيار لا يتم الخروج من الاجراء Else ' فى حالة اختيار تعم يتم عمل تمييز للخلايا بالتفريغ أو بالتعديل أو التلوين أو الفلاش ' ------------------------------------------------------------ ' تمييز الخلايا التى بها اخطاء بالتعديل ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Value = "معادلة خاطئة" ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالتفريغ ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Value = "" ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالتلوين ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Interior.ColorIndex = 3 ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالفلاش For Each C In Sheets("Sheet1").Range("A2:F20") If IsError(C.Value) Then C.Select With C For i = 1 To 2 ' عدد مرات الوميض Application.Wait (Now + TimeValue("0:00:01")) ' انتظار مؤقت لمدة ثانية .Interior.ColorIndex = 6 Application.Wait (Now + TimeValue("0:00:01")) .Interior.ColorIndex = 7 Next .Interior.ColorIndex = xlNone .Font.Color = -16777024 End With End If Next '------------------------------------------------------------ End If End Sub تفضلوا المرفق وتقبلوا تحياتى select all cells if contains Error value .rar3 points
-
مثال بسيط عن الماكرو فى الاكسيل المثال مشروح على برنامج PDF حمل من المرفقات الماكرو.rar3 points
-
3 points
-
أبدأ بحمد الله أولا وأخيرا على ما انعم ووفق وأصلي واسلم على الرحمة المهداة والسراج المنير نبينا محمد وعلى آله وصحبه وسلم ... وبعد كل عام وأنتم بخير وأعاد الله علينا أيامه الكريمة بالخير واليمن والبركات في موضوع اخي الكريم ابو عبدالرحمن وطلبه لواجهة برنامج لتسجيل الأطفال لرياض الاطفال او الروضة علي هذا الرابط فضلت ان تكون في مشاركة منفصلة لتعميم الفائدة ان شاء الله تعالى بشكل بسيط وجذاب صدقة جارية لفارس من فرسان منتدانا أوفيسنا أخي ومعلمنا عماد الحسامي رحمة الله عليه ورحم جميع المسلمين وغفر لهم الأحياء منهم والأموات حتي لا أطيل عليكم شرح مبسط للبرنامج أترككم لتجربة البرنامج في المرفقات وارحب بمشاركتكم في اجراء اية تعديلات وفقنا الله واياكم للصالحات مع تحياتي // ضاحي الغريب KG_Dahy.rar الان الاصدار الثاني علي الرابط التالي اضغط هنا2 points
-
السلام عليكم ورحمة الله وبركاته أضع بين يدي أخوتي الكرام في هذا المنتدى الأغر ملف رائع حصلت عليه به شرح لجميع دوال إكسل (حوالي 340 دالة) مع رابط لكل دالة لشرح أكثر من موقع مايكروسوفت worksheet functions.rar2 points
-
السّلام عليكم و رحمة الله و بركاته أستاذى الفاضل عادل حنفى بارك الله فيك ، سلمت من كل شر ، شرفنى مرورك أستاذى الكريم أخى العزيز زيزو البسكرى بارك الله فيك دائما تشرفنى بمرورك العزيز أخى وأستاذى الغالى ياسر خليل أشكرك بحرارة على هذا التشجيع الدائم والمستمر وهذا ما تعلمته من المنتدى ومنك تحديداً أستاذى الفاضل2 points
-
2 points
-
الأستاد الفاضل جرب الكود التالي في ال ThisWorkbook Module: Private Sub Workbook_Open() If MsgBox("Do you want to add this workbook to the Windows startUp ?", vbYesNo + vbQuestion) = vbYes Then AddToWinStartUp Me.FullName, True End If End Sub Private Sub AddToWinStartUp(ByVal File As String, ByVal Add As Boolean) CreateObject("wscript.shell").RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\", IIf(Add, File, vbNullString), "REG_SZ" End Sub للتدكير فقط ممكن أن يختلف ال (Key Path ( Microsoft\Windows\CurrentVersion في اصدارات أخرى للويندوز .. كما أن المستخدم User ينبغي أن يتوفر على الحق Privileges في تغيير الريجيستار Registry لازالة الملف من قائمة البرامج عند بدء تشغيل الويندوز شغل الكود التالي : AddToWinStartUp Me.FullName, False2 points
-
2 points
-
السلام عليكم ورحمة الله في الملف المرفق تجد طريقتين لما طلبته... بن علية Book1.rar2 points
-
الأخ الكريم أبو عبد الرحمن يرجى تغيير اسم الظهور للغة العربية إليك الملف المرفق Book1.rar2 points
-
أخي الغالي المتميز مختار يعجبني أسلوبك في التعامل مع الأكواد ..أسلوب جديد ومميز ورائع جزيت خيراً على الموضوع الرائع والذي يستحق منا أن نصفق له بحرارة2 points
-
أبي الحبيب أبو يوسف دائماً ما تتفوق علينا بكلماتك الرقيقة الطيبة ..بارك الله فيك وجزيت خير الجزاء أخي الحبيب المتميز المغازل رمهان بصراحة أحلى غزل وأحلى دالة في الموضوع ..مشكور على المشاركة بهذه الدالة المميزة الأخ الكريم قلم الإكسيل الحمد لله أن تم المطلوب على خير ونورت المنتدى بين إخوانك وننتظر منك التواجد بيننا لنستفيد منك وتستفيد منا تقبلوا تحياتي2 points
-
السلام عليكم ورحمة الله وبركاته.. أخي الكريم يحيى حسين..وفقك الله لما يحب ويرضى. مباركة عليكم هذه الشهادة التي حصلت عليها...نرجو الله أن تكون باباً تدخلون من خلاله إلى خدمة مجتمعنا العربي والإسلامي..وأن تكون أول الغيث لكم ولجميع إخوتنا الكرام في هذا المنتدى الكريم وخصوصاً أخي وحبيبي في الله ياسر خليل أبو البراء لأنه يستحقها أيضاً بجدارة ...ولا أنسى عمالقة الإكسيل جميعاً ...الذين يستحقون كل تقدير.. والسلام عليكم.2 points
-
السلام عليكم أخي قلم الإكسل ...دعاء طيب لا أحسد أخي أبو البراء عليه ولكنني أرجو أن ينالنا شيء منه... فالدال على الخير كفاعله.............تقبل تحياتي.. شكرا لك استاذي العزيز فعلا لو الله ثم انت بتوجيه رسالتي الى هنا ربما لن تحصل الفائدة الكبرى من مهندس المبدعين ابو البراء حفظه الله وبارك له في حياته واعدو الله ان يجعلك مساعدا للمساكين مثلي ويرحم بك عباده ويبارك لك في رزقك وعمرك ويمنحك الصحة الابدية والحفظ الازلي من كل شر شكرا مرة اخرى لمهندسنا الغالي ابو البراء والله يوفقك في كل امورك ويسهل عليك حاجتك وتقضى بمجرد التفكر فيها ونلتقي في موضوع اخر2 points
-
السلام عليكم أخي قلم الإكسل ...دعاء طيب لا أحسد أخي أبو البراء عليه ولكنني أرجو أن ينالنا شيء منه... فالدال على الخير كفاعله.............تقبل تحياتي.. السلام عليكم أخي أبو البراء الحبيب...أعتقد أن دوالك وأكوادك لا تخضع للتجريب كونها من مصدر ثقة ووعي ودراسة وإتقان...جزاكم الله خيراً... والحمد لله أن روح الدعابة وألقها بدا من خلال قبعتك التي لم ترفعها....ذلك يدعني أقول زاح شرك وزال همك وطاب عيشك بإذن الله...المحب لكم.2 points
-
جرب الدالة التالية Function YK(sInp As String) As Long Static bInit As Boolean Dim asMap() As String Dim asLtr() As String Dim I As Long Static aiVal(0 To 255) As Long If Not bInit Then asMap = Split("1 1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 26 27 28") asLtr = Split("أ ا إ ب ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ف ق ك ل م ن ه ة و ي") For I = 0 To UBound(asMap) aiVal(Asc(asLtr(I))) = asMap(I) Next I bInit = True End If For I = 1 To Len(sInp) YK = YK + aiVal(Asc(Mid(sInp, I, 1))) Next I End Function Sum Letters YasserKhalil V3.rar2 points
-
اخواني السلام عليكم لوحط في الفترة الاخيرة عدة امور تعيق من يتطوع بالمساعدة في هذا المنتدي الذي ننتمي اليه جميعا ونريد ان نري تفاعلا به بالشكل الذي يستفيد منه اكبر عدد ممكن ولا يجعل المتطوع يمل لكثرة المواضيع التي تطلب اياما للرد عليها مثلا نجد - وضع عدة نقاط في مشاركة من عضو ما ويريد عمل برنامج بناء علي هذه النقاط التوضيح المنتدي ولا اخص اي مستوي من مستويات العضوية موجودين بالفعل للمساعدة للتعليم او لايجاد حل لمشكلة بفكرة افضل واسهل او ايجاد للفكرة من اساسه وليس لعمل برنامج كامل ولكن قد يقوم احد الاعضاء بعمل برنامج لعمله ووجد البرنامج (او صادفه) قد يستفيد منه احد او يكون اداة للتعلم وهذا لا يوجد مانع منه اما ان تطلب برنامج كامل اذا فانت لا تريد ان تتعلم بل تريد استنزاف وقت من يحاول مساعدتك - بعض الاعضاء يطلب طلبا واذا حدث تاخر الرد عليه يفتح موضوع جديد بنفس الطلب فتجد اشخاصا يردون عليه هنا واخرون هناك مما يستنزف الوقت والجهد فبرجاء المساعدة لنا جميعا ليستفيد الجميع تحياتي2 points
-
الأخ الكريم غرب الإكسيل (متخليك شرق عشان تكون معانا) جرب الدالة المعرفة التالية علها تفي بالغرض Function CalcString(S As String) Dim ArrLetters, ArrValues, X() As Byte, SpaceCounter As Long Dim I As Long, Counter As Long, Pos& ArrLetters = Join(Array("أ", "ا", "إ", "ب", "ت", "ث", "ج", "ح", "خ", "د", "ذ", "ر", "ز", "س", "ش", "ص", "ض", "ط", "ظ", "ع", "غ", "ف", "ق", "ك", "ل", "م", "ن", "ه", "ة", "و", "ي")) ArrValues = Array(1, 1, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 26, 27, 28) X = StrConv(S, vbFromUnicode) For I = 0 To UBound(X) Pos = InStr(ArrLetters, Chr(X(I))) If Pos > 0 Then Counter = Counter + ArrValues((Pos - 1) / 2) Next I SpaceCounter = SpaceCount(S) CalcString = Counter - SpaceCounter End Function Function SpaceCount(ByVal strLine As String) As String Dim Str As String Dim TempCount As Long Dim I As Long Str = Trim(strLine) TempCount = 0 For I = 1 To Len(Str) If Mid(Str, I, 1) = " " Then TempCount = TempCount + 1 Else If TempCount > 0 Then SpaceCount = SpaceCount & " " & TempCount TempCount = 0 End If End If Next I SpaceCount = Mid(SpaceCount, 2) End Function وإليك الملف المرفق Sum Letters.rar2 points
-
بسم الله الرحمن الرحيم الاخوه الكرام بعد فترة انقطاع عن تقديم سلسلة علمنى كيف اصطاد بسبب الانشغال من الانتهاء ببرنامج EMA بشكله الجديد وبعد ان انتهيت منه بحمد لله أقدم لكم اليوم بمشيئة الله شروحات عن الفورم Form من البدايه حتى الاحتراف بأذن الله الدرس الاول 1- الدخول الى محرر الاكواد ( Visual Basic ) بالضغط على Alt+ f11 سيظهر معك الصوره التاليه 2- لو نظرنا الى الصوره السابقه سنجد كلمة Insert عليها دائره حمرا قم بالضغط على كلمة Insert ستظهر لك الصوره التاليه 3 - اضغط على UserForm كما هو مبين بالصوره اعلاه سيظهر لك الصوره التاليه 4- فى الصوره السابقه لو نظرنا لها سنجد شريط الادوات كما هو موضح بالصوره التاليه 5-صندوق ادوات التحكم ToolBox كما هو موضح بالصوره التاليه كما هو موضح بالصوره عاليه سوف نكتب نبذه صغيره عن كل عنصر من عناصر التحكم (طبعا الكلام هيكون نظرى وانا شخصيا لا اقتنع بالنظرى ) ولكن هى مجرد نبذه صغيره وبعد ذالك سوف نقوم بسرد كل عنصر فى درس مخصص بشرح وافى وكافى وبالصور والامثله العملية والتطبيقيه بأذن الله تعالى اولا :- المؤشر ( Pointer ) *** تستخدم هذه الاداه فى اضافة ادوات تحكم جديده غير ظاهره بصندوق التحكم ثانيا :- العنوان ( Lable ) *** هى أداه تستخدم لكتابه عنوان ثالثا :- صندوق النص ( Text Box ) *** وهى اداه تسمح للمستخدم بكتابة نص او رقم أو اى شئ بداخلها رابعا:- أداة السرد والحوار ( ComboBox) *** وهى أداه يمكن اضافة لها قائمة محدد يسمح للمستخدم الاختيار منها وهى مثل القائمة المنسدله بالاكسيل خامسا :- صندوق القوائم ( ListBox ) *** وهى اداه تشبه وعاء يحتوى على بيانات يمكن اضافه هذا المحتوى من Text Box او ComboBox ثم ترحيل هذا المحتوى الى شيت الاكسيل أو رفع محتوى من شيت الاكسيل وعرضه بـ ListBox سادسا :- صندوق الفحص (Check Box) *** تستخدم لعمل عدة صناديق فحص واختيار واحد او اكثر منهما سابعا:- زر الاختيار (Option Box ) *** تستخدم هذه الاداه فى عرض عدة بدائل امام المستخدم لاختيار احدهما فقط ثامنا:- زر التبديل (Toggle Button) *** هى اداه تشبه المفتاح الكهربائى له خيارين أما on أو Off ولكن بالاكسيل هذه الاداه لها خيارين أما true وأما false تاسعا:-الاطار (Frame) *** ويستخدم لعمل اطار لمجموعه عناصر عاشرا:- زر الامر (Command Button) *** هو زر يتم من خلال تنفيذ الكثير من الاكواد او التعليمات البرمجيه احدى عشر :- شريط التبويب ( Tab Strip) *** تتيح للمستخدم من عرض ادواته على شكل صفحات عرض اثنى عشر :- شريط الصفحات (Multi Page)*** تتيح للمستخدم من عرض ادواته على شكل صفحات عرض ثلاثة عشر :- شريط الانزلاق (Scroll Bar) *** هى اداه لها شكلان شكل عمودى واخر افقى وهى تشبه بحد كبير الاداه Spin Button اربعة عشر :- زر التدوير ( Spin Button) *** هى اداه تستخدم لزياده قيمة معينه او نقصانها ويتم تحديد قيمة عليا وقيمة سلفه ومقدار هذه القيم خامس عشر :- صوره( Image) *** وهى اداه تتيح للمستخدم من ادراج صوره بداخلها وان شاء الله كما قلت سوف نقوم بشرح كل جزء بدرس خاص **************************************************************************************************** 5- خصائص الفورم ( Properties Window) انظر للصوره التاليه الان نقوم بشرح أول جزء من عناصر التحكم فى صندوق التحكم أولا : - المؤشر ( Pointer ) تستخدم هذه الاداه فى اختيار ادوات تحكم اخرى غير ظاهره بصندوق التحكم من خلال الضغط كليك يمين على السهم سيظهر لك Additional Controls كما هو مبين بالصوره التاليه وعند الضغط على Additional Controls ستجد الصوره التاليه فى الصوره السابقه ستجد على اليسار فى الاسفل Show وتحتها مربع به علامه صح لو قمت بحذف علامة صح من المربع ستجد القائمة على اليمين ظاهر بها كل عناصر التحكم انظر للصور التاليه بعد االه علامه الصح فى الصوره السابقه خامس خيار ضع علامه صح Calendar Control 12.0 ثم اضغط اوك ستجد ان عنصر التحكم Calendar Control 12.0 موجود بصندوق عناصر التحكم كم هو موضح بالصوره فى الصوره السابقه لو نظرت الى صندوق التحكم ستجد ان عنصر Calendar Control 12.0 ظاهر كما هو موضح بالدائره الحمراء الصغيره اضغط على هذه الايقونه ثم اذهب الى الفورم وقم بالرسم التقويم ستجده كما هو محاط بالدائره الاحمراء الكبيره فى الصوره السابقه وبكدا يبقى عرفنا ازاى انضيف عنصر تحكم جديد الى صندوق التحكم والى لقاء اخر بأذن الله فى سلسه علمنى كيف اصطاد تقبلوا تحياتى ********************************************* الاخوة الكرام اليوم بمشيئة الله نواصل شروحات عن الـ Label بناء على طلب استاذى الفاضل ابويوسف ( يرجى التعريج على بعض الخصائص الأخرى مثل Auto size حجم تلقائي .. و Control Tip Text حيث نقوم بكتابة نص داخله ليعطينا تعليقاً على عمل الـ Label ) الخاصيه Auto size :- هى خاصيه تحمل خيارين true و False عن اختيارك true فأن عرض الـ Label سوف يكون تلقائى حسب محتوى النص بداخله وعند اختيارك False فأنه يتم توقف خاصيه عمل عرض تلقائى حسب طول النص للـ Label وبالتالى لابد من تحديد العرض اثناء التصميم او من خلال البرمجه كما سنرى لاحقا الخاصيه Control Tip Text :- هذه الخاصيه عند كتابى اى شئ بداخلها فأنها تعرض النص كتلميح عند وقوف الماوس على الـ Label ملحوظه ( عدم شرحى للخاصيه Control Tip Text فى السابق لانى لا ارى فائده لها فوظيفة الـ Label هى عنوان لشئ فى الفورم فأنت لا تحتاج عمل تلميح ) عموما تم التنويه عنها انت بس تأمر يا ابويوسف ************************************************************************************ اليوم بمشيئة الله هنتكلم عن المحور الثالث وهو استخدام البرمجه الخاصه بالـ Label عند عمل Label جديد على الفورم كما هو ظاهر بالصوره التاليه انظر الى المربع الاحمر الكبير على يسار الصوره والمكتوب عليه رقم 3 هذه هى خصائص الـ Label عند التصميم من شاشة الخصائص فماذا لو حبينا نعمل الخصائص من خلال الاكواد مثال:- اضغط دبل كليك على الفورم وهنعمل كود فى حدث فتح الفورم اتبع الصوره التالية فبعد تنفيذ الخطوات كما هو موضح بالصوره السابقه ستجد التالى شاهد الصوره فى الصوره السابقه المربع الاحمر هو مكان كتابه الاكواد أول شئ عايزين نجعل Label Back color لونه اصفر هنكتب التالى label1.b مجرد كتابة ليبل 1 وبعدها نقطه ( تكتب من خلال جعل لغه الكيبورد انجليزى ثم الضغط على حرف ز ) ستظهر لك قائمة عند كتابة حرف B سوف يتم فلترة القائمه طبقا للحرف المكتوب شاهد الصوره ثم نقوم باختيار BackColor Label1.BackColor = 65535 كتبنا اسم الـ Label1 وبعدها (.) ثم اسم الخاصيه ثم (=) ثم النتيجة المطلوبه 255 تشير الى جعل خلفية الـLabel لونه اصفر اليك صوره بارقام الالوان فى الفيجوال بيسك ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- ولو عايزين نعمل نص للـ Label هيكون كالتالى Label1.Caption = "بسم الله الرحمن الرحيم" لو لاحظنا جعلنا النص بين علامتى تنصيص وتكتب من خلال (shift+حرف ط ) ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- ولو حابين نحدد حجم الخط هيكون كالتالى Label1.Font = 20 ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- ولوحابين نحدد سماكة الخط هيكون كالتالى بعد يساوى ستجد خيارين أما True أو False على سبيل المثال هنختار True لجعل سماكه الخط ثخين Label1.Font.Bold = True ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- ولو حابين نجعل تاثر للـLabel بشكل خاص ممكن كالتالى Label1.SpecialEffect = fmSpecialEffectRaised ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- ولو حابين نخلى النص داخل اللـLabel فى المنتصف كالتالى (تحديد محازاة النص داخل الـ Label ) Label1.TextAlign = fmTextAlignCenter ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- ولتحديد ارتفاع الـlabel كالتالى Label1.Height = 50 ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- ولو حابين نحدد عرض الـ label كالتالى Label1.Width = 150 ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- هذا هو الكود بشكله النهائى Private Sub UserForm_Initialize() Label1.BackColor = 65535 Label1.Caption = "بسم الله الرحمن الرحيم" Label1.Font = 20 Label1.Font.Bold = True Label1.SpecialEffect = fmSpecialEffectRaised Label1.TextAlign = fmTextAlignCenter Label1.Height = 50 Label1.Width = 150 End Sub اضغط Run أو اضغط F5 شاهد الفورم وشوف الـ label ازاى شكله ستجده كالتالى هل يوجد طريقه اخرى لكتابه الكود بشكل ابسط نعم يوجد طريقه اخرى من خلال استخدام With شاهد الكود كالتالى Private Sub UserForm_Initialize() With Label1 .BackColor = 65535 .Caption = "بسم الله الرحمن الرحيم" .Font = 20 .Font.Bold = True .SpecialEffect = fmSpecialEffectRaised .TextAlign = fmTextAlignCenter .Height = 50 .Width = 150 End With End Sub هنا استخدمنا with وطبعا لازم نقفل with ب End with ثم تكتب ( . ) وبعدها اسم الخاصيه ثم (=) جرب بنفسك وحاول اكتب الكود واى استفسار انا تحت امرك والى لقاء اخر مع درس جديد من دروس علمنى كيف اصطاد ( TextBox) انتظرونا تقبلوا تحياتى ********************************************* بسم الله الرحمن الرحيم الاخوه الكرام اليوم موعدنا بمشئية الله عن شرح TextBox كما قلنا من قبل ان TextBox هو صندوق ادخال يتم ادخال فيه نص او رقم من المستخدم اثناء العمل على الفورم أن شاء الله هيتم تناول الموضوع على اربع مراحل 1- كيفية انشاء TextBox على الفورم اثناء عملية التصميم 2- التعرف على خصائص الفورم من شاشة الخصائص اثناء عملية التصميم 3-وقت تنفيذ الكود الخاص بالـ TextBox 4-التعامل مع الـ TextBox فى لغة البرمجه 5-كيفية عمل تنسيقات للقيم المدخله نبدأ بسم الله أولا :- كيفية انشاء TextBox على الفورم اثناء عملية التصميم من صندوق التحكم أضغط على الايقونه المشار لها بحرف ِabl ثم اذهب الى الفورم وقم برسم TextBoxعلى الفورم بالابعاد اللى المناسبه لك من عرض وارتفاع شاهد الصوره التاليه توضح لك الامر فى الصوره السابقه يوجد Label1 و textBox1 هذه هى العناصر اللى موجوده على الفورم لو حابين نعمل Label و textBox ممكن يكون من خلال الطريقه السابقه وهى اضغط على العنصر المراد اضافته الى الفورم من صندوق التحكم ثم قم برسمه على الفورم وممكن من خلال الوقوف على العنصر يعنى تحديده ثم كليك يمين ستظهر قائمه اختر منها Copy دلوقتى انا عايز اعمل Label و textBox قم بتحديد Label1 واضغط على زر Ctrl من الكيبورد واستمر بالضغط عليه ثم بالماوس حدد textBox1 ثم اضغط كليك يمين بالماوس ستظهر قائمه اختر Copy ثم اذهب الى اى مكان فاضى فى الفورم واعمل كليك يمين واختر Paste او من خلال الكيبورد الضغط على زر Ctrl +زر حرف V ستجد انه تم انشاء Label2 و textBox2 وطبعا هيكون بنفس تنسيق خصائص Label1 و textBox1 شاهد الصوره --------------------------------------------------------------------------------------------------------------------------------------------- ثانياً :- التعرف على خصائص الفورم من شاشة الخصائص اثناء عملية التصميم شاهد الصوره التالية لخصائص الـ TextBox هنمسك اهم الخصائص والاكثر شيوعا فى الاستخدام ونبدا نشرح بالتفصيل الخاصيه (Name) :- Name هو اسم الـ TextBox المستخدم فى الاكواد وعند انشاء اى TextBox يقوم الفيجوال بيسك بأعطاء اسم افتراضى له TextBox1 واذا قمنا بعمل TextBox ثانى فأن الفيجوال بيسك يعطى له اسم افتراضى TextBox2 وانا افضل عدم تغيير اسماء TextBox الافتراضيه التى عرفها الفيجوال بيسك فعندما نريد كتابه كود خاص بالعنصر TextBox1 فى حدث Change على سبيل المثال يكون بداية الكود كالتالى Private Sub TextBox1_Change() فأذا قمنا بتغيير اسم TextBox1 كما عرفه الفيجوال بيسك الى اسم اخر من خاصيه Name وليكن مثلا غيرناه الى (Nomber ) فهنا عند كتابة كود فى حدث Change يكون كالتالى Private Sub Nomber_Change() ففى حال تغيير الاسم وعدم التزامك بالاسم داخل محرر الاكواد وكتابة كود يحدث Error ------------------------------------------------------------------------------------------------------------------------------------------------ الخاصيه ( Back Color) هذه الخاصيه تتيح للمستخدم تغيير لون خلفية TextBox1 على اليسار يوجد سهم اضغط عليه ستظهر لك قائمة يمكنك من خلالها اختيار اللون المناسب كما يحلو لك أنظر الصوره التاليه ---------------------------------------------------------------------------------------------------------------------------------------------- الخاصيه ( Control Source) وهذه الخاصيه تتيح للمستخدم تحديد خلية محدده تظهر محتواها فى TextBox1 عند عرض الفورم والعكس صحيح بمعنى ان اى ادخال فى TextBox1 يظهر مباشره فى الخليه التى قمت بكتابتها فى الخاصيه Control Source فعلى سبيل المثال لو كتبنا ان Control Source هو محتوى الخليه A1 فعند عرض الفورم ستجد ان محتوى الخليه ظاهر فى الـ TextBox1 ولو قمت بتعديل المحتوى الموجود فى TextBox1 وضغط انتر سوف يتغير مباشره فى الخليه A1 الخلاصه انه يجعل خلية محدده مربوطه بالـ TextBox1 شاهد الصوره --------------------------------------------------------------------------------------------------------------------------------------- الخاصيه ( Enabled ) هذه الخاصيه تحمل خيارين true و False عند اختيار true سوف يكون بأمكان المستخدم ادخال او تعديل محتوى TextBox1 وعند اختيار False لا يكون بأمكان المستخدم ادخال او تعديل محتوى TextBox1 شاهد الصوره عند اختيار False ---------------------------------------------------------------------------------------------------------------------------------------- الخاصيه (Font) :- وهذه الخاصيه تتيح للمستخدم التحكم فى نوع وسماكة وحجم الخط للنص داخل الـ TextBox1 الافتراضى فى الفيجوال بيسك نوع الخط هو ( Tahoma ) والسماكه هى (Regular) وحجم الخط هو ( 8) الخاصيه (Font Color) :- وهذه الخاصيه تتيح للمستخدم التحكم فى اختيار لون الخط للنص داخل الـ TextBox1 مثال عند اختيار نوع الخط (Traditional Arabic) والسماكه ( Bold ) وحجم الخط (18) شاهد الصوره ------------------------------------------------------------------------------------------------------------------------------------------ الخاصيه ( Height ) وهذه الخاصيه تتيح للمستخدم التحكم فى ارتفاع الـ TextBox1 فيمكنك أما من خلال التصميم السحب بالماوس للاسفل لتحديد الارتفاع للـ TextBox1 أو كتابة رقم للارتفاع فى الخاصيه Height ------------------------------------------------------------------------------------------------------------------------------------------ الخاصيه ( Width) هذه الخاصيه تتيح للمستخدم التحكم فى عرض الـ TextBox1 كما يمكن ايضا التحكم فى عرض الـ TextBox1 من خلال التصميم على الفورم بالماوس ------------------------------------------------------------------------------------------------------------------------------------------ الخاصيه (Left) :- وهذه الخاصيه تتيح للمستخدم التحكم فى بعد الـ TextBox1 عن الضلع الايسر للفورم الخاصيه (Top) :- وهذه الخاصيه تتيح للمستخدم التحكم فى بعد الـ TextBox1 عن الضلع الاعلى للفورم مثال لو وضعنا قيمة Left 126 *** وقيمة Top 90 ستجد الصوره التالية ----------------------------------------------------------------------------------------------------------------------------------------------- الخاصيه ( Locked ) هذه الخاصيه تحمل خيارين true و False عند اختيار False سوف يكون بأمكان المستخدم ادخال او تعديل محتوى TextBox1 وعند اختيار True لا يكون بأمكان المستخدم ادخال او تعديل محتوى TextBox1 يعنى هيكون فى حمايه على TextBox1 ---------------------------------------------------------------------------------------------------------------------------------------- الخاصيه ( Maxlenght ) هذه الخاصيه يمكن من خلالها التحكم فى عدد الاحرف او الارقام المدخله بالـ TextBox1 لو حضرتك عايز تجبر المستخدم على ادخال وليكن عدد 8 أحرف فقط اكتب فى خاصيه Maxlenght رقم 8 فلو حب المستخدم يكتب ( محمد خالد ) فأنه لا يستطيع الا كتابة (محمد خال) لماذا لانه تم تحديد عدد الادخال 8 فقط واحد هيقولى محمد خالد عددها 8 حروف هقوله ان الفيجول هيقوم بعد الفاصله اللى بين محمد وبين خالد وبالتالى (محمد 4 حروف + 1 فاصله + خال 3 حروف كدا =8) شاهد الصوره ------------------------------------------------------------------------------------------------------------------------------------------ الخاصيه ( Multiline ) هذه الخاصيه تحمل خيارين true و False عند اختيار False سوف يكون عرض المحتوى اللى بيتم ادخاله او تعديل فى محتوى TextBox1 على سطر واحد فقط وعند اختيار True سوف يكون عرض المحتوى اللى بيتم ادخاله او تعديل فى محتوى TextBox1 على عدة اسطر ويجب مراعاة تعديل ارتفاع TextBox1 ليظهر اكثر من سطر شاهد الصوره ------------------------------------------------------------------------------------------------------------------------------------------ الخاصيه ( Password char ) هذه الخاصيه يمكن من خلالها التحكم فى طريقة أظهار القيم المدخله بالـ TextBox1 لو حضرتك عايز تجعل القيم المدخله فى TextBox1 على شكل ( * ) مثلا شاهد الصوره التالية ------------------------------------------------------------------------------------------------------------------------------------------ الخاصيه ( ScrollBars ) هذه الخاصيه تحمل اربع خيارات ويبدأ العدد من 0 الى 3 0- FMScrollBarsNone ( هذا يعنى الغاء خاصيه ScrollBars ) 1-FMScrollBarsHorizontal ( هذا يعنى عمل ScrollBars للـ TextBox1 بشكل أوفقى ) 2-FMScrollBarsVertical ( هذا يعنى عمل ScrollBars للـ TextBox1 بشكل رأسى ) 3-FMScrollBarsBoth ( هذا يعنى عمل ScrollBars للـ TextBox1 بشكل أفقى و رأسى مع بعض ) *** الاختيار رقم 1 وهو عمل ScrollBars للـ TextBox1 بشكل أوفقى لابد من جعل خاصيه Multiline تكون False يعنى يكون الكتابه على سطر واحد وبكدا يعمل سكرول بار افقى للوصول الى اخر السطر **** الاختيار رقم 2 وهو عمل ScrollBars للـ TextBox1 بشكل رأسى لابد من جعل خاصيه Multiline تكون True يعنى يكون الكتابه على عدة أسطر وبكدا يعمل سكرول بار رأسى للوصول الى اخر السطر **** الاختيار رقم 3 وهو عمل ScrollBars للـ TextBox1 بشكل رأسى واخر افقى بصراحه حاولت استخدمه لكن لم يظهر معى بشكل افقى وراسى وتفسير ذالك هى الخاصيه Multiline لانها تحمل خيارين اما الادخال يكون على سطر واحد وبالتالى فان الاسكرول بار الرأسى لا يوجد له فائده وأما الادخال على عدة اسطر متتاليه وبالتالى ان الاسكرول بار الافقى لي له فائده هذا والله اعلم ( مش عايز افتى فى شئ لا اعلمه واترك الامر للخبراء ) شاهد الصوره -------------------------------------------------------------------------------------------------------------------------- الخاصيه (Visible ) وهذه الخاصيه تتيح للمستخدم التحكم فى ظهور او عدم ظهور TextBox1 عند عرض الفورم وعند الضغط على السهم المجاور لها ستجد لها خيارين True و False عندد اختيار True سوف يظهر الـ TextBox1 على الفورم عند فتحه ( وهذا هو الخيار الافتراضى من الفيجوال بيسك ) وعند اختيار False ٍسوف يختفى الـ TextBox1 على الفورم عند فتحه يعنى هيكون غير ظاهر ومخفى لا يراه المستخدم -------------------------------------------------------------------------------------------------------------------------- الخاصيه (Tab index ) وهذه الخاصيه تتيح للمستخدم ترتيب التنقل بين الازرار على الفورم بعد الخروج منها من خلال الزر انتر ويمكن تعطيل هذه الخاصيه من خلال استخدام الخاصيه Tab stop = True الخاصيه (Tab Stop ) وهذه الخاصيه تحمل خيارين True و False عندد اختيار True يتم تعطيل خاصيه Tab index وعند اختيار False ٍسوف تفعل خاصيه Tab index للتنقل بين الازرار حسب الترتيب الذى ترغب فيه ------------------------------------------------------------------------------------------------ الخاصيه (Text Align) :- وهذه الخاصيه تتيح للمستخدم التحكم فى اتجاه بداية النص داخل الـ TextBox1 هل يكون يميناً أو يساراً أو وسط TextBox1 لو ذهبت للخصائص وعند الخاصيه Text Align ستجد سهم اضغط عليه ستجد 3 خيارات امامك وهى fm Text Align Left -1 عند الاختيار ستجد ان اتجاه النص داخل TextBox1 يبداء من اليسار fm Text Align Center -2 عند الاختيار ستجد ان اتجاه النص داخل TextBox1 فى المنتصف fm Text Align Right -3 عند الاختيار ستجد ان اتجاه النص داخل TextBox1 يبداء من اليمين ------------------------------------------------------------------------------------------------------------------------- رقم 20 الخاصيه ( ٍِSpecial Effect ) هذه الخاصيه من الخصائص الهامه للـ TextBox1 وهى تعطى اشكال مبهره ومميزه للـ TextBox1 ولها خمس اشكال شاهد الصوره التاليه كما تشاهدون فى الصوره على اليسار دائره حمرا وبداخلها سهم يمكنك الضغط على السهم سيظهر لك قائمة الخيارات للاشكال اخترمنها الشكل المناسب لك جرب كل الاشكال واطلع علىها واختر ما يناسب زوقك ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- كدا الحمد لله انتهينا من المحور الاول وهو عملية التصميم ورسم TextBox وايضا انتهينا من المحور الثانى وهو اهم خصائص الـ TextBox ان شاء الله المره القادمه نتكلم عن المحور الثالث وهو وقت تنفيذ الكود الخاص بـ TextBox ارجوا من الله ان اكون وفقت بالشرح واى استفسار انا تحت امر الجميع تقبلوا تحياتى *********************************************1 point
-
السلام عليكم ورحمة الله تفضل اخي ابو جنى 14 Abo Jana الملف حسب طلبك علي الرابط التالي : http://www.officena.net/ib/topic/63955-تحديد-فتره-تجريبيه-للملف/ الملف قم بالعمل علية حتى تاريخ 2016/12/31 بعد ذلك سيغلق الملف ولن يفتح إلا بكلمة مرور فعند إدخال كلمة المرور صحيحة سيقوم الملف بإخفاء جميع الصفحات ماعدا (عدى) الصفحة الرئيسية والمحدده مسبقاً تستطيع تغييرها والتحكم بها وعندما تفتح هذه الصفحة المحددة سيقوم الملف بإخفاء جميع الاعمدة ماعدا (ماعدى) الاعمدة المطلوبة التي بها البيانات التي تخص ممن يقوم بالعمل علي البرنامج والمحدده مسبقاً A,B,C,D,E,F تستطيع تغييرها والتحكم بها مع تحيات / اخوكم في الله KHMB ابو الحسن والحسين protection date limite KHMB.rar1 point
-
حقيقة انا احتاج الى قرن من الزمن لاستطيع التطبيق ولكن من باب حب لاخيك ما تحبه لنفسك ولاعتقادى انه مفيد للغير نقلته هنا مع العلم انه يمكن يكون من البدائيات لكم ولكن لعل احد من الاشخاص يستفيد منه1 point
-
السلام عليكم ورحمة الل وبركاته مرفق طيه ثلاثة ملفات بهم شرح رائع ومبسط باللغة الإنجليزية لإكسل - اكتشفوها بنفسكم basic_excel_techniques.rar1 point
-
اخي الخازمي سيكون شكل الكود كالتالي If Sheets(I).Cells(r, 4) = [D5] And Sheets(I).Cells(r, 5) = [E5] Then تحياتي1 point
-
السلام عليكم أخي محمد للأسف لا يمكن عمل هذا بالاكسس والظاهر ان الاستاذ رمهان سبقني في الاجابة المختصرة واليك الاجابة المفصلة لعمل الحيلة: بس انا افضل النموذج frm_Option_Group والكود حقه: Private Sub Frame10_Click() If Me.Frame10.Value = 1 Then Me.Page1.SetFocus ElseIf Me.Frame10.Value = 2 Then Me.Page2.SetFocus ElseIf Me.Frame10.Value = 3 Then Me.Page3.SetFocus End If End Sub جعفر 228.RTL_Tabs.mdb.zip1 point
-
اخي محمد اولا كل عام وانتم بخير بعد الزحمة ثانيا : لاتحضرني طريقة مباشرة ! ولكن اليك هذه الفكرة : من خاصية نمط ومن تبويب تنسيق اختر = بلا وهنا يمكنك وضع ازرار امر او مجموعة خيار بها زر تبديل ومن اليمين لليسار وعند النقر هناك كود يفتح التاب المحددة ! تحياتي1 point
-
اخي ضاحي لمسة وفاء منك تشكر عليا والله يرحم الحسامي ويجعلها في ميزان حسناته تحياتي1 point
-
وعليكم السلام أخي محمد اعمل صورة من البرنامج ، واخبرني كيف تريده يصير آسف ما فهمت المصطلحات جعفر1 point
-
1 point
-
فكرة جيدة وجديرة بالدراسة ولكن في رأيي أنه معقدة نوعاً بمعنى أنك لكى توصيل لذلك التفقيط المثالي لا بد من خوضك لأكثر من معادلة وكل واحدة ترتبط بالأخرى .1 point
-
شكرا لك استاذي الجليل وبارك لك في عمرك والى الامام لا تنسانا من مواضيعك القيمة1 point
-
بسم الله ما شاء الله ألف ألف مبروك أخي وحبيبي يحيى حسين أنت تستحقها بجدارة ... بس تعال قولي هنا : كيف حصلت عليها ؟ هل هذه الشهادة تقدم من خلال مسابقة .. نريد أن نعرف التفاصيل؟ تقبل تحياتي1 point
-
1 point
-
1 point
-
اخي العزيز مختار حسين محمود تسلم يداك عمل اكثر من رائع تحياتي1 point
-
نجحت والحمد لله اولا واخيرا نجحت والحمد لله اولا واخيرا نجحت والحمد لله اولا واخيرا وشكرا لك يا مبدع يا مهندس الابداع يا ابو براء يا ابوالهندسة كلها حماك الله في حلك وترحالك وفي مشيك ونومك ويقظتك وعفا عنك وغفر لك ولوالديك ووسع عليك واعطاك ما تتمنى في الدنيا والاخرة "اشتغلت الدالة "1 point
-
السلام عليكم هذا ملف شامل كما طلبت , يعمل مع كل الملفات من نوع csv طريقة الاستخدام 1/ افتح الملف المرفق (فرز وترتيب البيانات) 2/اكتب في العمود A (وابتداءا من السطر 2 ) اسم الملف من نوع csv الذي تريد فرز بياناته 3/ افتح الملف csv الذي حددته ثم اذهب إلى الملف المرفق (فرز وترتيب البيانات)واضغط الزر تحياتي ملاحظة ما ستكتبه في السطر الأول في هذا المرفق (فرز وترتيب البيانات) سيظهر في بداية الملفات المفروزة جرب المرفق فرز وترتيب البيانات.rar1 point
-
اخي عبد العزيز البسكري انا لا اريد ان اثبت او ان اضيف فبالفعل هذا موجود اخي ياسر خليل أبو البراء دائما تسرق الكلمة من علي لساني فتسبقني قبل ان ارد زي ما بيقولوا القلوب عند بعضها عموما هذا ليس الا للتذكرة السريعة لملاحظتي في عدة مشاركات ليس الا فانا لايهمني ابدا عمل برنامج كامل بل بالعكس عندما يكون الرد علي سؤال مركز تستطيع الاجابة عليه بالشكل الوافي مما يجعل الاستفادة منه عالية بعكس البرنامج ولا انتم مش معايا؟ تحياتي1 point
-
السلام عليكم اخواني الكرام قد بينت في اخر مشاركة لي هنا كيفية الاستفسار عن الدرس اكتب ما تريد في موضوع جديد مع ارفاق مثال بالمحاولة ولا بأس من وضع رابط لهذا الدرس داخل موضوعك الجديد1 point
-
السّلام عليكم و رحمة الله و بركاته أخي الكريم أبو عبد الرحمان و ريتاج .. ما تطلبه أمر بسيط للغاية .. فقط العمليّة تحتاج إلى بعض الايضاحات لو تفضّلت ..شكل الواجهة التقريبي من وجهة نظرك .. الرقم القومي ممّ يتكوّن و هل له عدد محدّد من الأرقام ..وإن شاء الله ستجد المساعدة و ستُمد لك يد العون من كل السّادة الأعضاء .. جزاهم الله خيرًا و زادها بميزان حسناتهم فائق احتراماتي1 point
-
هل هدا ما تقصده : (غير حروف الاسم ABDEL AZIZ الى العربية ) ... لاحظ أنني غيرت الكود TextOut hdc, 30, 20, Message & " " & iCounter, Len(Message & " " & iCounter) Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type LOGBRUSH lbStyle As Long lbColor As Long lbHatch As Long End Type Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Private Const WS_CHILD = &H40000000 Private Const WS_CLIPCHILDREN = &H2000000 Private Const WS_CAPTION = &HC00000 Private Const WS_EX_TOPMOST = &H8& Private Const SW_NORMAL = 1 Private Const TRANSPARENT = 1 Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Const COLOR_BTNFACE = 15 Private bWindowExist As Boolean Public Sub Test() If Not bWindowExist Then Call ShowUpdatingMessage( _ Message:="ABDEL AZIZ", _ Title:="Officena", _ HowManyTimes:=10, MessageDelay:=1, _ TOPMOST:=True, TextColor:=vbRed, BackColor:=vbYellow _ ) End If End Sub Private Sub ShowUpdatingMessage( _ ByVal Message As String, _ ByVal Title As String, _ ByVal HowManyTimes As Single, _ Optional ByVal MessageDelay As Single, _ Optional ByVal TOPMOST As Boolean, _ Optional ByVal TextColor As Long, _ Optional ByVal BackColor As Long) Const WIDTH = 250 Const HEIGHT = 120 Dim tRect As RECT Dim tLb As LOGBRUSH Dim t As Single Dim hBrush As Long Dim hwndChild As Long Dim hwndParent As Long Dim hdc As Long Dim iCounter As Integer On Error GoTo CleanUp ' Application.EnableCancelKey = xlErrorHandler hwndParent = CreateWindowEx(IIf(TOPMOST, WS_EX_TOPMOST, 0), "BUTTON", Title, WS_CAPTION + WS_CLIPCHILDREN, _ (GetSystemMetrics(SM_CXSCREEN) - WIDTH) / 2.2, (GetSystemMetrics(SM_CYSCREEN) - HEIGHT) / 2, WIDTH, HEIGHT, 0, ByVal 0&, 0, ByVal 0&) hwndChild = CreateWindowEx(0, "STATIC", vbNullString, WS_CHILD, 0, 0, WIDTH, HEIGHT, hwndParent, ByVal 0&, Application.hInstance, ByVal 0&) If hwndChild Then bWindowExist = True Application.OnKey "%{F4}", "" ShowWindow hwndParent, SW_NORMAL ShowWindow hwndChild, SW_NORMAL DoEvents hdc = GetDC(hwndChild) SetBkMode hdc, TRANSPARENT If TextColor <> 0 Then SetTextColor hdc, TextColor End If SetRect tRect, 0, 0, WIDTH, HEIGHT tLb.lbColor = IIf(BackColor = 0, GetSysColor(COLOR_BTNFACE), BackColor) hBrush = CreateBrushIndirect(tLb) For iCounter = 1 To HowManyTimes FillRect hdc, tRect, hBrush TextOut hdc, 30, 20, Message & " " & iCounter, Len(Message & " " & iCounter) ' TextOut hdc, 115, 50, CStr(iCounter), Len(CStr(iCounter)) t = Timer Do DoEvents Loop Until Timer - t >= IIf(MessageDelay = 0, 1, MessageDelay) Next End If CleanUp: ReleaseDC hwndChild, 0 DeleteObject hBrush DestroyWindow hwndChild DestroyWindow hwndParent bWindowExist = False Application.OnKey "%{F4}" End Sub1 point
-
السلام عليكم تكملة و اثراء لهدا الموضوع لقد كتبت الكود التالي الدي يعرض رسالة على فترات زمنية متقطعة بدون اللجوء الى اليوزرفورم و بدون امكانية الغائها من طرف المستخدم كما هو مطلوب أعلاه Private Sub ShowUpdatingMessage( _ ByVal Message As String, _ ByVal Title As String, _ ByVal HowManyTimes As Single, _ Optional ByVal MessageDelay As Single, _ Optional ByVal TOPMOST As Boolean, _ Optional ByVal TextColor As Long, _ Optional ByVal BackColor As Long) ال Routine اعلاه تعطي المستخدم مرونة اختيار موضوع الرسالة و عدد المرات التي سيتم فيها عرضها و مدة كل رسالة و ال Z order لنافدة الرسالة و لون الحروف و لون الخلفية طبعا لو نص الرسالة طويل فعلى مستعمل الكود أن يغير طول و عرض (WIDTH and HEIGHT Constantes) النافدة لاستعاب كل النص مرة أخرى نظرا لكتابة الكود على الويندوز 32 بت فانه لن يعمل على اويندوز و الأوفيس 64 بت لقطة من الشاشة: ملف للتحميل : https://app.box.com/s/vk5xn38vlqzik7lmts8m4q2svloix525 الكود في موديول عادي : Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type LOGBRUSH lbStyle As Long lbColor As Long lbHatch As Long End Type Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Private Const WS_CHILD = &H40000000 Private Const WS_CLIPCHILDREN = &H2000000 Private Const WS_CAPTION = &HC00000 Private Const WS_EX_TOPMOST = &H8& Private Const SW_NORMAL = 1 Private Const TRANSPARENT = 1 Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Const COLOR_BTNFACE = 15 Private bWindowExist As Boolean Public Sub Test() If Not bWindowExist Then Call ShowUpdatingMessage( _ Message:="Showing message number : ", _ Title:="Officena", _ HowManyTimes:=10, MessageDelay:=1, _ TOPMOST:=True, TextColor:=vbRed, BackColor:=vbYellow _ ) End If End Sub Private Sub ShowUpdatingMessage( _ ByVal Message As String, _ ByVal Title As String, _ ByVal HowManyTimes As Single, _ Optional ByVal MessageDelay As Single, _ Optional ByVal TOPMOST As Boolean, _ Optional ByVal TextColor As Long, _ Optional ByVal BackColor As Long) Const WIDTH = 250 Const HEIGHT = 120 Dim tRect As RECT Dim tLb As LOGBRUSH Dim t As Single Dim hBrush As Long Dim hwndChild As Long Dim hwndParent As Long Dim hdc As Long Dim iCounter As Integer On Error GoTo CleanUp ' Application.EnableCancelKey = xlErrorHandler hwndParent = CreateWindowEx(IIf(TOPMOST, WS_EX_TOPMOST, 0), "BUTTON", Title, WS_CAPTION + WS_CLIPCHILDREN, _ (GetSystemMetrics(SM_CXSCREEN) - WIDTH) / 2.2, (GetSystemMetrics(SM_CYSCREEN) - HEIGHT) / 2, WIDTH, HEIGHT, 0, ByVal 0&, 0, ByVal 0&) hwndChild = CreateWindowEx(0, "STATIC", vbNullString, WS_CHILD, 0, 0, WIDTH, HEIGHT, hwndParent, ByVal 0&, Application.hInstance, ByVal 0&) If hwndChild Then bWindowExist = True Application.OnKey "%{F4}", "" ShowWindow hwndParent, SW_NORMAL ShowWindow hwndChild, SW_NORMAL DoEvents hdc = GetDC(hwndChild) SetBkMode hdc, TRANSPARENT If TextColor <> 0 Then SetTextColor hdc, TextColor End If SetRect tRect, 0, 0, WIDTH, HEIGHT tLb.lbColor = IIf(BackColor = 0, GetSysColor(COLOR_BTNFACE), BackColor) hBrush = CreateBrushIndirect(tLb) For iCounter = 1 To HowManyTimes FillRect hdc, tRect, hBrush TextOut hdc, 30, 20, Message, Len(Message) TextOut hdc, 115, 50, CStr(iCounter), Len(CStr(iCounter)) t = Timer Do DoEvents Loop Until Timer - t >= IIf(MessageDelay = 0, 1, MessageDelay) Next End If CleanUp: ReleaseDC hwndChild, 0 DeleteObject hBrush DestroyWindow hwndChild DestroyWindow hwndParent bWindowExist = False Application.OnKey "%{F4}" End Sub1 point
-
1 point
-
السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله كل عام وأنتم بخير والأمة الإسلامية بخير ************** أقدم لكم موضوع خفيف .. الموضوع ببساطة كالتالي نفترض أن لديك بيانات في الصف الأول وتريد تقسيم البيانات بشكلٍ ما إلى عدة أعمدة ، وفي كل عمود عدد معين من البيانات بالمثال يتضح المقال في الصف الأول ضع أرقام من 1 إلى 40 في الأعمدة من A إلى AN (ركز في الصف الأول وليس في العمود الأول) في الخلية A3 سنقوم بوضع معادلة تؤدي مهمة التقسيم .. المعادلة بهذا الشكل =INDEX($1:$1,,1+MOD(ROWS($A$3:A3)-1,8)+8*(COLUMNS($A$3:A$3)-1)) كيفية استخدام المعادلة : المعادلة وضعت في الخلية A3 ومن ثم عندما تريد التعديل في المعادلة بما يتناسب مع ملفك قم بالتغيير في المعادلة في الأجزاء التالية ROWS($A$3:A3) COLUMNS($A$3:A$3) أي أن خلية البداية سيتم الإشارة إليها في المعادلة أما الجزء الأول خاص برقم الصف الذي يحوي البيانات المراد تقسيمها $1:$1 آخر جزئية في المعادلة هو الرقم 8 (لما الرقم 8 مكتوب مرتين في المعادلة) ... بما أننا نريد تقسيم الـ 40 بيان إلى أعمدة وفي كل عمود 8 بيانات على سبيل المثال إذاً سيتم التعامل مع ( 40 / 8 = 5 ) أي 5 أعمدة بعد وضع المعادلة في الخلية A3 يتم سحب المعادلة بمقدار 8 صفوف إلى أسفل و 5 أعمدة باتجاه السحب إليكم الملف المرفق فيه تطبيق للفكرة علها تفيدكم وتنال إعجابكم بالنسبة لشرح المعادلة أتركها للأخ الحبيب المتمكن خالد الرشيدي (بما لديه من ملكة - بفتح اللام يا أخ علاء رسلان وليس بكسرها - وموهبة فذة في شرح المعادلات) حمل الملف من هنا تقبل الله منا ومنكم صالح الأعمال1 point
-
السلام عليكم ورحمة الله وبركاته إخواني الكرام في المنتدى الغالي أقدم لكم موضوع بسيط جداً ألا وهو كيفية إظهار المعادلات في الخلايا بدون أكواد سبق أن قدمت على الرابط التالي موضوع حول هذا الخصوص باستخدام دالة معرفة رابط الموضوع الآن بدون أكواد يمكن عمل ذلك بمنتهى اليسر والسهولة روح للتبويب Formulas ثم انقر على Name Manager ثم انقر New (وكفاية كدا نقر عشان منقلبش فراخ) اكتب اسم للنطاق الذي سيتم تسميته باسم ShowFormula ليكون معبر عن الهدف من المعادلة ، وفي الحقل المسمى Refers to اكتب المعادلة التالية =GET.CELL(6,INDIRECT("RC[-1]",FALSE)) وأخيراً أوك ... بس خلاص كدا الخطوة الكبيرة انتهت روح للخلايا اللي فيها المعادلات واكتب جنبها المعادلة التالية =ShowFormula هتظهر لك المعادلات المكتوبة في الخلايا في الملف المرفق تطبيق لما تم شرحه حمل الملف من هنا لا تنسونا بصالح دعائكم تقبلوا تحياتي1 point
-
الأستاذ / إيهاب سعيد السلام عليكم ورحنة الله وبركاته إليك الملف لعله المطلوب. AAA1.rar1 point
-
accesswordlink.rarتعبنا كثيرا في البحث عن طريقة لتنسيق النص كما في الورد واخيرا وجدنا مثال في هذا المنتدى الرائع والذي افضاله علينا كثيره ، اخذنا هذا المثال وعدلنا عليه بخبرتنا المتواضعة ونعتقد ان شا الله انه وصلنا لنتيجة مرضية نتمنى ان يستفيد منها الجميع هذا مثال ارفقناه وهو عبارة عن تعريف لموظف يقوم الاكسس باصداره عن طريق تعليمات برمجية الى قالب وورد وبه امكانية العرض والطباعة المباشرة من الورد .1 point
-
مشكورررررررر اخي الله يوفقك جربته ممتاز البرنامج ولاكن سجلت فيه بيانات جديده ولا يقبلها مايظهر غير الموجود سابقاً وياليت تشرحلي كيف علمته لني عندي اكثر من 6 حقول ابي اربطها في الورد1 point