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

أخي الكريم أما آن لك أن تقوم بتغيير اسم الظهور للغة العربية مسألتك في منتهى البساطة وليس لها علاقة بالكود ... في الملف يوجد تنسيق شرطي ..يمكنك الإطلاع عليه من التبويب Data ثم الأمر Conditional Formatting واختار Manage Rules ستجد معادلة التنسيق بهذا الشكل =NOT(ISBLANK(A6)) وتعني إذا لم تكن الخلية في العمود الأول فارغة يتم التنسيق بالشكل المطلوب وبجانب المعادلة يوجد النطاق الذي سيتم تطبيق التنسيق عليه قم بتعديل النطاق ليناسب الأعمدة التي تريدها =$A$6:$I$40 لا تنسى أن تحدد أفضل إجابة وأن تضغط على كلمة "أعجبني هذا" وأن تلتزم بالتوجيهات والنصائح المقدمة لك من الأخوة الأعضاء (يا مستر تويوتا)

السلام عليكم اخوانى وأساتذتى فى المنتدى وكل عام وأنتم بخير بمناسبة عيد الفطر اليوم أقدم لكم كيفية عمل اختصار لملف اكسل به صورتك على سطح المكتب فقد لفت نظرى طلب أحد الأخوة لهذا الموضوع لذلك قررت أن أضع بين أيديكم الطريقة الآتية 1 - فى ملف اكسل أدرج هذا المديول Option Explicit Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GetActiveWindow Lib "user32" () As Integer Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Const CSIDL_PERSONAL = &H5 Private Type SHITEMID cb As Long abID As Byte End Type Private Type ITEMIDLIST mkid As SHITEMID End Type Dim FSO As New FileSystemObject Dim FLD As Folder Function UserNameOffice() As String UserNameOffice = Application.UserName End Function Public Function DesktopAddress() As String DesktopAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator End Function Private Function GetSpecialFolder(CSIDL As Long) As String Dim Path As String Dim FolderPath As Object Dim IDL As ITEMIDLIST Dim sh As New Shell32.Shell Set FolderPath = sh.NameSpace(5) If Not FolderPath Is Nothing Then GetSpecialFolder = FolderPath.Self.Path Exit Function End If GetSpecialFolder = "" End Function Function DirExists(strDirectory As String) As Boolean DirExists = (Dir(strDirectory, vbDirectory) <> "") End Function Sub Desktop_Shortcut() Dim WBName As String, Path As String, WB_Link As String, WB_Name As String Dim DesktopPath As String, TargetPath As String, StrSave As String Dim WSHShell As Object, MyShortcut As Object Set WSHShell = CreateObject("WScript.Shell") Dim FSO As Object, Folder As Object, File As Object Set FSO = CreateObject("Scripting.FileSystemObject") Dim WB As Workbook Set WB = ThisWorkbook Dim WSh As Worksheet Set WSh = Sheet1 WBName = WB.Name Path = "MyFile" DesktopPath = WSHShell.SpecialFolders("Desktop") WSh.Range("C2").Value = WB.Name WB_Name = WSh.Range("C3").Value WB_Link = WSh.Range("C4").Value On Error GoTo ErrHandle If Not DirExists("C:\" & WB_Name) Then 'Check C Drive If Not DirExists(GetSpecialFolder(CSIDL_PERSONAL) & "\" & WB_Name) Then 'Check My Documents Set FSO = CreateObject("Scripting.FileSystemObject") 'If not in C Drive or My Documents - then create shortcut FSO.CreateFolder "C:\" & WB_Name ChDir "C:\" & WB_Name SavePicture Sheet1.Image1.Picture, WB_Name & ".ico" 'Picture pasted onto Image1 on Sheet 1 - Link Shortcut Set FSO = CreateObject("Scripting.FileSystemObject") Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & "\" & WB_Link) With MyShortcut .TargetPath = WB.FullName .IconLocation = "C:\" & WB_Name & "\" & WB_Name & ".ico" .WindowStyle = 1 .Description = "EEZIAdmin" .WorkingDirectory = WB.Path .Save End With Else End If End If ErrHandle: Set WSHShell = Nothing End Sub 2 - فى شيت 1 الخلية C3 ضع المعادلة =IF($C$2="";"";IF(MID($C$2;(LEN($C$2)-4);"1")=".";LEFT($C$2;LEN($C$2)-5);IF(MID($C$2;(LEN($C$2)-3);"1")=".";LEFT($C$2;LEN($C$2)-4);""))) وفى الخلية C4 ضع المعادلة الآتية =IF($C$3<>"";$C$3&".lnk";"") 3 - فى شيت 1 ادراج Image وعليها صورة : ندرج الـ Image كالتالى من developet tab ثم insert ثم more controls ثم Microsoft forms 2.0 image ثم ok ارسم الـــــ Image فى الشيت وبعدين كليك يمين عليها واخنر Properties فى قائمة الخصائص التى تظهر دور على الخيار Picture واعمل ادراج لأى صورة من على جهازك على الـ Image واحفظ وشغل الكود لكم كل التحية والتقدير Desktop Shortcut mokhtar.rar

تم تعديل الملف كي يعمل فقط على المعادلات اختر فقط من القائمة المنسدلة رقم السيارة و اكسل يقوم بالباقي اضغط اعجبني او افضل اجابة اذا كان كذلك المخالفات.zip

أخي الكريم عبد الواحد بعد فتح الملف بكلمة السر المميزة للأخين محمد حسن وعلاء رسلان (علامة النجمة) روح للأمر Save As حفظ باسم واختار تنسيق الملف Xlsm نفس التنسيق القديم وبجانب كلمة Save ستجد كلمة Tools بجانبها سهم صغير (ممكن تستخدم عدسة مكبرة عشان السهم صغير) انقر السهم هتلاقي General Options أي خيارات عامة انقر عليها واحذف كلمة السر واضغط Ok ثم أخيراً Save لو هتحفظ الملف في نفس المسار هيظهر لك رسالة تأكيد الاستبدال .. اضغط Yes للموافقة على الاستبدال أو غير اسم الملف الجديد باسم تاني وخلي القديم بكلمة السر زي ما هو (زي ما تحب .. تاكل سوداني أو تأزأز لب)

أخي الحبيب علاء بدلاً من استخدام جدول للنوع يمكن تعديل المعادلة لتؤدي الغرض بهذا الشكل بدون الاستعانة بجدول =VLOOKUP(A2,{"ذكر","ي";"أنثى","ت"},2,0)&IF(H2>=16,"وجه",IF(AND(G2>=10,H2<16),"نتقل","عيد السنة"))

شكرا استاذنا / خالد الرشيدي و جزاك الله كل خير و شكرا للاستاذ / ياسر خليل ابوالبراء المعادلة كما توقعت دائما و اكثر بارك الله لكم جميعا و اقدم لكم جميعا كل تقدير و عرفان

اليك هذا الملف يمكنك اختايار المرتبة التي تريد و تبديل الاسماء التي تناسب العاشرة /الرابعة /الاولى حسب الختيار من الخلية J1 اضغط افضل اجابة اذا كان كذلك أعلى نتيجة اختيارية.zip

بارك الله فيك أخي وحبيبي في الله خالد الرشيدي معادلة في منتهى الجمال والروعة زيادة في الخير وإثراءً للموضوع أقدم لكم حل بدالة معرفة والدالة للعلامة الكبير عبد الله باقشير - غفر الله لنا وله - Function Kh_Names(FullName As String, ParamArray Index1()) As String Dim I As Integer Dim Kh_Split, MyArray, Arr Dim Kh_String As String, SN As String, RE As String On Error GoTo Err_Kh_Names MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الحق", " النصر", " العهد", " النور", " بالله") SN = Application.WorksheetFunction.Trim(FullName) For Each Arr In MyArray RE = Replace(Arr, " ", "^") SN = Replace(SN, Arr, RE) Next Kh_Split = Split(SN, " ", , vbTextCompare) On Error Resume Next For I = 0 To UBound(Index1) Kh_String = Kh_String & " " & Kh_Split(Index1(I) - 1) Next On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") Kh_Names = Kh_String Exit Function Err_Kh_Names: Kh_Names = "" End Function استخدام الدالة =Kh_Names($F2,COLUMN(A$1)) أو يمكن بهذا الشكل =Kh_Names($F2,1) الرقم 1 يمثل الاسم الأول .. استخدم نفس المعادلة واستبدل الرقم 1 برقم 2 لاستخراج الاسم الثاني وهكذا تقبلوا تحياتي :fff: Split Compound Names.rar

الأخ الفاضل محمود بك إليك شرح للخطوط العريضة فقط وليس لتفاصيل المعادلة Transfer Data Based On Two Conditions By Formulas Help.rar

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

الاخ ياسر الف شكر على التهنئة و( آآآآآآآآآآآآآآآآآآآآآآآآآمين)

الأخ أحمد الطحان هل المطلوب تم على خير ..لم تذكر ولم تشر إلى ذلك الأمر الأخ الحبيب سليم والأخ الغالي مختار والأخ المتميز ياسر فتحي مبارك الترقية المستحقة عن جدارة بارك الله فيكما وجمع الله بيننا في الفردوس الأعلى من الجنة (قولوا آمين) تقبلوا تحياتي وكل عام وأنتم بخير

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

اخى الفاضل جرب المرفق لعلة المطلوب وابدى ملاحظاتك ان كان ما تريد قم بتحديدة كمجاب إقرار.rar

السلام عليكم أخى الفاضل ziso 777 حبذا لو غيرت اسمك الى اللغة العربية طبقا لتعليمات المنتدى أخى الكريم راجع الرابط التالى فله علاقة مباشرة بطلبك http://www.officena.net/ib/index.php?showtopic=62799

اليكم الفيديو الثانى ادراج الصور وعمل موضوع بها وقريبا الفيديو الثالث

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

السلام عليكم ...بصراحة بهذه المعادلة ...اختصرت معادلات..جزاك الله خيراً...ناجحة 100%

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

السلام عليكم...نجمة أو نجم.... لاأعلم والله أعلم.

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

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

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

دائما مبدع اخي ياسر لا حرمك الله الاجر خير الناس انفعهم للناس

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

عموماً إليك الكود التالي عله يفي بالغرض إن شاء المولى Sub Test() Dim Coll As New Collection, ArrSheet, ArrTemp, ArrHolder, ArrOut1, ArrOut2 Dim I As Long, J As Long, P As Long, P1 As Long, P2 As Long, Str1 As String ArrSheet = Array(Sheets("مباع"), Sheets("مفعل"), Sheets("active"), Sheets("راجع")) ReDim ArrHolder(1 To Rows.Count, 1 To (UBound(ArrSheet) + 2)) ReDim ArrOut1(1 To Rows.Count, 1 To 1) ReDim ArrOut2(1 To Rows.Count, 1 To 1) For J = LBound(ArrSheet) To UBound(ArrSheet) ArrTemp = ArrSheet(J).Range("A2").CurrentRegion.Columns(1).Value On Error Resume Next For I = 1 To UBound(ArrTemp, 1) Str1 = CStr(ArrTemp(I, 1)) Coll.Add Key:=Str1, Item:=Coll.Count + 1 P = Coll(Str1) ArrHolder(P, 1) = ArrTemp(I, 1) ArrHolder(P, J + 2) = ArrHolder(P, J + 2) + 1 Next I On Error GoTo 0 Next J For I = 1 To Coll.Count P = 0 For J = 2 To UBound(ArrHolder, 2) P = P + Sgn(ArrHolder(I, J)) Next J If (P = UBound(ArrSheet) + 1) Then P1 = P1 + 1 ArrOut1(P1, 1) = ArrHolder(I, 1) Else P2 = P2 + 1 ArrOut2(P2, 1) = ArrHolder(I, 1) End If Next I With Sheets("النتيجة المطلوبة") .Range("A2").Resize(P1).Value = ArrOut1 .Range("B2").Resize(P2).Value = ArrOut2 End With End Sub سيتم استخراج الأرقام المتشابهة في كل أوراق العمل الأربعة معاً في العمود الأول أما الأرقام التي لم تحقق الشرط ستكون في العمود الثاني في ورقة العمل الأخيرة لا تنسى أن تحدد أفضل إجابة وأن تضغط على كلمة "أعجبني هذا" في حالة أن أعجبك الحل تقبل تحياتي Similar Data In Multi Sheets YasserKhalil.rar

أخي الكريم أشرف .. وهشام كمال الأخ الحبيب المتابع للموضوع من بدايته أخي وحبيبي علاء رسلان إليكم إصدار أفضل من الدالة المعرفة .. وبالمثال يمكنكم التعامل مع أي بيانات إن شاء الله Public Function Wish(RngData As Range, RngWish As Range, Start_WishColumn As Long, End_WishColumn, MarkColumn As Long) Dim ArrData, ArrWish, ArrOut, ArrSwap Dim ColCount As Long, I As Long, J As Long, K As Long ArrData = RngData.Value ArrWish = RngWish.Value For I = 1 To UBound(ArrWish, 1) ArrWish(I, 2) = ArrWish(I, 2) Next I ReDim ArrOut(1 To UBound(ArrData, 1), 1 To 1) ColCount = UBound(ArrData, 2) ReDim ArrSwap(1 To 1, 1 To ColCount) For I = 1 To (UBound(ArrData, 1) - 1) For K = I To UBound(ArrData, 1) If ArrData(K, MarkColumn) > ArrData(I, MarkColumn) Then For J = 1 To ColCount ArrSwap(1, J) = ArrData(I, J) ArrData(I, J) = ArrData(K, J) ArrData(K, J) = ArrSwap(1, J) Next J End If Next K Next I For I = 1 To UBound(ArrData, 1) For J = Start_WishColumn To End_WishColumn If ArrOut(I, 1) = "" Then For K = 1 To UBound(ArrWish, 1) If ArrData(I, J) = ArrWish(K, 1) Then If ArrWish(K, 2) > 0 Then ArrOut(I, 1) = ArrWish(K, 1) ArrWish(K, 2) = ArrWish(K, 2) - 1 End If End If Next K End If Next J Next I For I = 1 To (UBound(ArrData, 1) - 1) For K = I To UBound(ArrData, 1) If ArrData(K, 1) < ArrData(I, 1) Then ArrSwap(1, 1) = ArrData(I, 1): ArrSwap(1, 2) = ArrOut(I, 1) ArrData(I, 1) = ArrData(K, 1): ArrOut(I, 1) = ArrOut(K, 1) ArrData(K, 1) = ArrSwap(1, 1): ArrOut(K, 1) = ArrSwap(1, 2) End If Next K Next I Wish = ArrOut End Function يتم تحديد النطاق الذي تريد النتائج به S8:S27 ثم في شريط المعادلات ضع المعادلة التالية =Wish(D8:R27,U12:V23,3,14,15) ثم اضغط على Ctrl + Shift + Enter البارامترات الخاصة بالمعادلة : البارامتر الأول : نطاق البيانات بالكامل D8:R27 البارامتر الثاني : نطاق الرغبات والذي يحتوي على الرغبات والحد الأقصى المسموح به البارامتر الثالث: عمود بداية الرغبات وهو في المثال العمود رقم 3 والعد يبدأ من بداية نطاق البيانات .. أي أن العد في المثال يبدأ من العمود D البارامتر الرابع: عمود نهاية الرغبات وهو في المثال العمود رقم 14 وكما أخبرنا العد يبدأ من بداية نطاق البيانات البارامتر الخامس والأخير: هو رقم عمود المجموع وهو في المثال رقم 15 وكما أخبرنا ونؤكد أن العد من بداية نطاق البيانات لا تنسونا من صالح دعائكم Pupils Distribution According To Marks & Wishes V2.rar

اخى الفاضل جرب الملف التالى ان كان ما تريد قم بتحديدة كأفضل إجابة ملف تقسيم الاسماء.rar

بارك الله فيك استاذنا يوسف وجاري المتابعة

اخى الفاضل جرب المرفق فاتورة الكهرباء.rar

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

وكل عام وحضراتكم بألف صحة وسعادة

بارك الله فيك استاذ ابوخليل , وشكرا للاستاذ يوسف

السلام عليك اخي الكريم اليك الحل كاملا بالفورم ترحيل استدعاء تعديل ان نسابك الحل اضغط افضل اجابة لتمام الموضوع كود ترحيل جميل جدا.rar

اخي الحبيب / خالد الرشيدي يسعدني مرورك كل سنة وحضرتك طيب

عيدكم مبارك وعساكم من العايدين كل سنه وبصحه سلامه يارب.. شكراً استاذ يوسف وعسى ان يكتب اجرها في ميزان حسناتك ياارب .. اتوقع فيها اخطاء بسبب الاوفيس اللي عندي , عندي 2010 ,,,, ( صاحب الموضوع الاستاذ يوسف , والاساتذه اللي ردو اثنو على الهديه يعني الخلل عندي انا مافيها كلام )

معك حق المرفق يشتمل على خطأ غير مقصود كان مصدر النموذج الفرعي استعلام محذوف تم اصلاح المثال في مشاركتي الاولى يمكنك التجربة الآن Experiment treeview2.rar

الجزء السادس

الجزء الخامس

الجزء الرابع

الجزء الثالث

الجزء الثاني

تفضل اخى واتمنى ان يكون هو المطلبإقرار.rar

أخي الفاضل يرجى عدم الالحاح في الطلب .. من لديه القدرة على المساعدة ، سيقوم بذلك بدون إلحاح .. تفضل الملف المرفق بالمعادلات .. ومتنساش تحدد أفضل مشاركة اللي فيها الإجابة المطلوبة كأفضل إجابة تقبل تحياتي Transfer Data Based On Two Conditions By Formulas.rar

الأخ الفاضل الغندور إليك المرفق التالي .. Transfer Data Based On Two Conditions.rar

شرح الطريقة : ( حسب المثال المرفق) لدينا نموذج غير منضم يشتمل على عدة حقول ومربع تحرير مصدره جدول معين ونريد عندما نختار اسما معينا من مربع التحرير ان تظهر بقية بيانات السجل اسم مربع التحرير combo1 واسماء الحقول الاخرى txt1 .. txt2.. txt3...... وهكذا ____________________________________________ لنلقي نظرة على محتويات مربع التحرير الداخلية : - ننقر بزر الفأرة الايمن على مربع التحرير ونختار خصائص - نفتح على لسان التبويب : بيانات - ننقر على النقاط الثلاث التي بجانب القيمة : مصدر الصف سيفتح الاستعلام الذي هو مصدر الصف لمربع التحرير لاحظ ان الاستعلام يحتوي على 8 اعمدة وهي الحقول الموجودة في سجل الجدول معرف العمود الاول = صفر معرف العمود الثاني = 1 معرف العمود الثالث = 2 وهكذا ........ هذه المعرفات سنحتاجها عندما نرغب في جلب البيانات من مربع التحرير _________________________________________ الآن نرجع الى النموذج على عرض التصميم وننقر على مربع التحرير بزر الفأرة الايمن - نفتح على لسان التبويب : حدث - ننقر على النقاط الثلاث التي بجانب القيمة : بعد التحديث سيفتح محرر الفيجوال ونلاحظ وجود سطرين جديدين ننسخ الجملة التالية ونلصقها بين السطرين Me.txt1 = combo1.Column(1) Me.txt2 = combo1.Column(2) Me.txt3 = combo1.Column(3) Me.txt4 = combo1.Column(4) Me.txt5 = combo1.Column(5) Me.txt6 = combo1.Column(6) Me.txt7 = combo1.Column(7) (Me.txt1 = combo1.Column(1 تعني : الحقل الاول في النموذج يساوي الحقل1 في مربع التحرير وهكذا ... امل ان يكون الشرح وافيا db.rar

أحتاج لخيار آخر غير InputBox بحيث يكون قابل للسيطرة و متناسقاً مع النظام من حيث الشكل وتنسيق النماذج !! هذه هينة بإذن الله ... قم بإنشاء نموذج بالحجم الذي تجده مناسبا قم بانشاء مربع نص بإسم Text000 قم بانشاء زر أمر بإسم ComClose وسمه OK قم بانشاء زر أمر بإسم ComCancel وسمه Cancel وفي محرر الفيجوال للنموذج ضع مجموعة الكودات التالية : Private Sub ComClose_Click() If IsNull(Me.Text000) Or Me.Text000 = "" Then MsgBox ("You did not provide anything!") Else MsgBox ("You entered: '" & Me.Text000 & "' as the value!") End If DoCmd.Close acForm, Me.Name End Sub Private Sub ComCancel_Click() MsgBox ("You pressed Cancel!") DoCmd.Close acForm, Me.Name End Sub Private Sub Form_Timer() DoCmd.Close acForm, Me.Name End Sub Private Sub Text000_Change() Me.TimerInterval = 0 End Sub التطبيق بسيط وفعاّل عند فتح النموذج وعدم التفاعل معه لمدة 10 ثواني يغلق تلقائياً عند إدخال أي نص في مربع النص تظهر الحروف على شكل نجمة (كلمة سر) بالموافقة على النص المدخل OK تظهر رسالة توضح النص المدخل ، وهنا يمكننا وضع الكود المناسب للتطبيق من حيث إعتماد القيمة أو رفضها ... في حال ترك مربع النص فارغاً وضغط OK تظهر سالة تفيد بانه لم يتم إدخال أي قيمة في حال الضغط على الزر Cancel يتم إشعارنا برسالة بخيارنا ويتم إغلاق النموذج جرب ....

في التقرير أريد أخفاء مربع نص من الصفحة الأولى فقط على أن يظهر في الثانية وما بعدها !! بسيطة ... في page header format نضع الكود التالي : If page > 1 Then Me.controlname.visible = false . . . Else Me.controlname.visible = true . . . End If

السلام عليكم ورحمة الله و بركاته بعد اذن الاخوة تعديل بسيط على الفورم و الكود و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته قاعدة بيانات ادخال وبحث HaNcOcK 2.rar

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