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

السلام عليكم ورحمة الله بارك الله بالإخوة الكرام ولإثراء الموضوع في المرفق يتم الوصول الى الاسم من خلال قائمة منسدلة واحدة في الورقة مثال1 يتم اختيار القائمة ثم من نفس الخلية يتم اختيار الاسم في الورقة مثال2 تظهر في القائمة المنسدلة بيانات صفوف واعمدة الجدول في امان الله قائمة منسدلة متغيرة.rar

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

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

السلام عليكم شاهد المرفق 2010 قائمة منسدلة تتغير بتغيير الخلية من قائمة إلى قائمة.rar

السلام عليكم استعمل هذا الكود في زر امر لاخفاء الصفوف Sub Hide() For Each cl In [G5:G300] If cl = 0 And cl <> "" Then cl.EntireRow.Hidden = True Next End Sub وهذا الكود في زر أمر للاظهار Sub Show() [G5:G300].EntireRow.Hidden = False End Sub

الأخ الكريم/ krimo145 السلام عليكم ورحمة الله وبركاته وبعد إستئذان الأخ الكريم/ محمد الشابورى صاحب المشاركات القوية جرب عمل الخطوات التالية - كمحاولات لحل المشكلة : 1- عند تسجيل المكتبة بالأمر Regsvr32.exe fm20.dll يجب تكون لك صلاحيات مسئول النظام Administrator 2- هل حدث الأمر فجأة ؟ بمعني لم تظهر الرسالة من قبل وبدأت تظهر حديثا - إن كان الوضع كذلك قم بعمل System Restore لإعادة الويندوز إلي حالته الأولي - حيث في بعض الحالات يكون الخطأ مرتبط بالريجستري 3- إذا كان الويندوز XP تأكد من تثبيت Service Pack 3 4- أعد نسخ الملف fm20.dll من السي دي وقم بتسجيله مرة أخري - لربما كان معطوبا . 5- تثبيت نسخة جديدة من برنامج الأوفيس هذا ما يحضرني الآن - بالتوفيق - تقبل تحياتي

تفضل أخى المصنف 4.rar

تفضل أخى Private Sub Workbook_NewSheet(ByVal Sh As Object) Application.ScreenUpdating = False x = Val(Sheets(1).Name) For i = 1 To Sheets.Count If Val(Sheets(i).Name) > x Then x = Val(Sheets(i).Name) Next Sh_Name = x + 1 ActiveSheet.Move After:=Sheets(Sheets.Count) ActiveSheet.Name = Sh_Name Sheets(1).Cells.Copy ActiveSheet.Range("A1").PasteSpecial xlPasteFormats ActiveSheet.Range("A1:G1").Value = Sheets(1).Range("A1:G1").Value Application.CutCopyMode = False Sheets(1).Select Application.ScreenUpdating = True End Sub المصنف 4.rar

الأستاذ / أيمن السلام عليكم ورحمة الله وبركاته عذراً فهمت أن نطاق اللون هو عنده التغيير .إليك الملف بعد التعديل. برنامج المقاومات (4).rar

الأستاذ / أبو البراء السلام عليكم ورحمة الله وبركاته المشكلة في الأكواد تم إعادة تسمية كود واشتغل الملف والحمد لله. شيت 22 صنايع.rar

السادة الزملاء تم تخديث الفيديوهات على اليوتيوب ورفعها على المنتدى كل فيديو فى مكانه أسئلة كثيرة تتردد على مسامعي منها على سبيل المثال : http://magdiyonis54.blogspot.com.eg/ كيفية تصميم شيت اكسل كيفية عمل جدول تنسيق الجدول كيفية إدخال البيانات إضافة الألوان وضبط النصوص دمج الخلايا أبجدة الأسماء التنسيق الشرطي الجمع ومستوى الطالب ( ممتاز جيد ......) وضع السري عمل التسلسل إظهار الصفوف وإخفائها هذه الأسئلة سأجيب عنها وبطريقة بسيطة وبعيد عن المعادلات للهواة أو لطالبى كيفية عمل شيت للامتحانات عنوان المنتدى http://magdiyonis1.forumegypt.net عنوان المدونة الخطوة الاولى.rar

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

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

يعني انك تريد ارجاع الحماية ؟ والسبب في عدم تمكنك هو في التسجيل او ما يسمى الريجستري ومؤكد انك استخدمت الاداة او ما يشابهها لتخفيض الامان HKEY_LOCAL_MACHINE, "Software\Microsoft\Office\11.0\Access\Security", "Level", 0) HKEY_CURRENT_USER, "Software\Microsoft\Office\11.0\Access\Security", "Level", 0) حيث يتم تنفيذ واحد من هذين السطرين فقط عند الارجاع اليدوي فقد مررت بهذه المشكلة والحل السريع هو أن تجرب المرفق الآخر لابي ياسر والذي يعيد الحماية الى اكسس lock.rar

استاذ // عبد الله المجرب استاذ // وليد فتحي بارك الله لكما وجزاكما عنا خيراً

استاذ عبدالله عذرا لم أري مشاركتك جزاك الله كل خير وزادك من علمه

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

أليك أخى المطلوب تصفية.rar

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

السلام عليكم الاخ الحبيب / محمود الاسيوطى بارك الله فيك ضع الكود التالي في حدث الشيت Entry بالشكل التالي ليجعل الزر نشط او غير نشط لتنفيذ عملية الترحيل Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("f14").Value = "يمكنك الترحيل" Then CommandButton1.Enabled = True ElseIf Range("f14").Value = "لا يمكنك الترحيل" Or Range("f14").Value = "ادخل بياناتك" Then CommandButton1.Enabled = False End If End Sub وقم بوضع الكود التالي في حدث زر الترحيل Private Sub CommandButton1_Click() Dim ws, ws1 As Worksheet Dim LR, LR1 As Long Dim iRow As Long Set ws = Worksheets("Database") Set ws1 = Worksheets("Entry") LR = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row ws.Cells(LR, 4).Value = ws1.[d14].Value ws.Cells(LR, 5).Value = ws1.[d15].Value ws.Cells(LR, 6).Value = ws1.[d16].Value ws1.Range("C20:F40").Copy ws.Select LR1 = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row ws.Cells(LR1, 7).Select ws.Paste ws.[d3].Select MsgBox "الحمد لله... تم ترحيل القيد بنجاح" ws1.Select Range("C18").Select Application.CutCopyMode = False End Sub تقبل خالص تحياتي مثال على الترحيل-SAMA.rar

هلا جعلته عربياً

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

السلام عليكم ورحمة الله أخي الكريم، المطلوب بعض الشرح حسب ما وضعته في الملف المرفق,,, أخوك بن علية المرفق : Book1.rar

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

السلام عليكم ورحمة الله وبركاته أخي الحبيب //أبو طارق ما زلت اقول لك (ليس هناك مشكلة) ولعلي جربت أخر ملف وضعه استاذنا // الشهابي في المشاركة رقم 15 وهو ليس به اي مشاكل على الاطلاق وقمت بتجريب كل النقاط وهو يعمل بصورة 100 * 100 ولكني اضفت له شي بسيط جدا لعله يكون السبب في المشكلة عندك وهو قمت بعمل تثبيت الادخال لخلايا النوع حتى تتفق الحروف مع حروف المعادلات جرب مرة أخرى واخبرني بالنتيجة.. العمل بكاملهbraa.rar

السلام عليكم الاخ الكريم / ۩◊۩ أبو حنين ۩◊۩ بارك الله فيك بعد اذن اخي الفاضل / وليد فتحي ... جزاه الله خيرا استخدم التعديل التالي علي الكود الخاص بك لتنفيذ طلبك Sub delete_datas() Application.ScreenUpdating = False sama = MsgBox("سيتم حذف بيانات الشيتات الأربعة (الاتوبيس-طائرة-مطروح-تعديل)... هل أنت متأكد من إجراء هذه العملية ؟", vbYesNo) If sama = vbYes Then '============================= On Error Resume Next For i = 2 To Sheets.Count Sheets(i).Select ActiveSheet.Unprotect ("1") Next i '============================= For Each Sh In Worksheets If Sh.Name Like "تعديل" Or Sh.Name Like "الاتوبيس" _ Or Sh.Name Like "مطروح" Or Sh.Name Like "طائرة" _ Then Sh.Select: Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents Next Else MsgBox "!! لم يتم التفريغ" End If '============================= On Error Resume Next For i = 2 To Sheets.Count Sheets(i).Select Sheets(i).Select ActiveSheet.Protect ("1") Next i '============================= Application.ScreenUpdating = True Sheets("عام").Select End Sub وان شاء الله سينفع معك او قم بوضع ملف كمثال للعمل عليه تقبل خالص تحياتي وجرب علي المرفقات تنفيذ كود مسح بيانات من شيتات مع حماية هذه الشيتات.rar

اخى الجموعى هل تقصد هكذا نموذج لشهادة مدرسية+طباعة.rar

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

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

abdalla89 ياسر الحافظ عبدالله المجرب nart lebzo شكرا لكم على شكركم ولعيونكم وعيون كافة أهل هذا المنتدى هذا هو الكود المصدري Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Enum RegHive HKEY_CLASSES_ROOT = &H80000000 HK_CR = &H80000000 HKEY_CURRENT_USER = &H80000001 HK_CU = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HK_LM = &H80000002 HKEY_USERS = &H80000003 HK_US = &H80000003 HKEY_CURRENT_CONFIG = &H80000005 HK_CC = &H80000005 HKEY_DYN_DATA = &H80000006 HK_DD = &H80000006 End Enum Enum RegType REG_SZ = 1 REG_BINARY = 3 REG_DWORD = 4 End Enum 'Public Const ERROR_SUCCESS = 0& Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long Private Function CreateRegKey(hKey As RegHive, strPath As String) Dim hCurKey As Long Dim lRegResult As Long lRegResult = RegCreateKey(hKey, strPath, hCurKey) If lRegResult <> ERROR_SUCCESS Then 'there is a problem End If End Function Private Function SaveRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long) Dim hCurKey As Long Dim lRegResult As Long lRegResult = RegCreateKey(hKey, strPath, hCurKey) lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4) If lRegResult <> ERROR_SUCCESS Then End If End Function Private Sub Timer1_Timer() Dim strVM As String Dim strVS As String On Error Resume Next strVM = SaveRegLong(HKEY_LOCAL_MACHINE, "Software\Microsoft\Office\11.0\Access\Security", "Level", 1) strVS = SaveRegLong(HKEY_CURRENT_USER, "Software\Microsoft\Office\11.0\Access\Security", "Level", 1) strVS = SaveRegLong(HKEY_CURRENT_USER, "Software\Microsoft\Office\12.0\Access\Security", "VBAWarnings", 1) strVS = SaveRegLong(HKEY_CURRENT_USER, "Software\Microsoft\Office\14.0\Access\Security", "VBAWarnings", 1) Unload Me End Sub

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