الـعيدروس قام بنشر أكتوبر 11, 2011 مشاركة قام بنشر أكتوبر 11, 2011 السلام عليكم الاخوة الاعزاء حفظكم الله هذا كود لتقييد التمرير بين صفوف والاعمدة ScrollArea ماعدا ثنايا الصفوف التي بها بيانات زايد صف فارغ و عمود فارغ افادني الكود في تقليص كبر حجم ملف الاكسل بالاستخدام الخاطئ وهو استخدامي طريقة التمرير السريع بين البيانات (الكنترول + الاسهم ) عند استخدامي للاختصار اكثر الاحيان اتاري وانا في الصف 65536 والاكسل كل حركه فيه بحسابه بمعنى يحسبه كيلو بايتات مافيه وقت المعذرة على الاطالة هذا هو الكود في حدث الشيت Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim LastColumn As Integer Dim LastRow As Long If WorksheetFunction.CountA(Cells) > 0 Then LastRow = Cells.Find(What:="*", After:=[A1], _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row If LastRow <> 65536 Then LastRow = LastRow + 1 LastColumn = Cells.Find(What:="*", After:=[A1], _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Column If LastColumn <> 256 Then LastColumn = LastColumn + 1 Me.ScrollArea = Range(Cells(1, 1), Cells(LastRow, LastColumn)).Address Else Me.ScrollArea = "" End If End Sub تحياتي رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر أكتوبر 17, 2011 الكاتب مشاركة قام بنشر أكتوبر 17, 2011 هذه بعض الاكواد المميزة و المتنوعة في كيفية تثبيت CommandButton في الورقة و التي تتم غالبا في حدث Worksheet_SelectionChange Freeze CommandButton1.rar Freeze CommandButton2.rar Freeze CommandButton3.rar Freeze CommandButton4.rar Freeze CommandButton5.rar Freeze CommandButton6.rar Freeze CommandButton7.rar Freeze CommandButton8.rar Freeze CommandButton9.rar 2 رابط هذا التعليق شارك More sharing options...
KHMB قام بنشر أكتوبر 19, 2011 مشاركة قام بنشر أكتوبر 19, 2011 السلام عليكم ورحمة الله وبركاتة اخي محمد جزاك الله خيراً ونفع بك المسلمين اخي ياريت إن امكن شرح الفائدة لكل زر امر البعض واضح من ان تنشط الخلية وياأتيك الزر إلى عندك لتقرعة لتنفيذ الامر وحسب رغبتك في موقعة اما بجانب الخلية او فوقها او تحتها او يمينها او يسارها وهذا جميل جدا ورائع باقي معرفة البعض الآخر مثل الثابتة او التي تتمركز في اليمين وتثبت اينما كانت شاكراً لكم سلفاً رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر أكتوبر 19, 2011 الكاتب مشاركة قام بنشر أكتوبر 19, 2011 الاخ الكريم يمكنك اضافة اي رقم الى كلمتي (Top - Left) مثلا +20 او +40 و لاحظ الفرق رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر أكتوبر 20, 2011 مشاركة قام بنشر أكتوبر 20, 2011 أخى الفاضل / يجيــــاوى سلام الله عليكم كما أنتم دائمـــا..أدام الله عليكم نعمة العلم بعد إذنكم قمت بوضعهم جميعا فى ملف واحد Freeze CommandButton.rar 2 رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر أكتوبر 23, 2011 الكاتب مشاركة قام بنشر أكتوبر 23, 2011 ادراج زر تصغير في اليوزر فورم (Minimize) هذا الكود في standar Module Private Declare Function FindWindowA Lib "USER32" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function GetWindowLongA Lib "USER32" _ (ByVal hWnd As Long, _ ByVal nIndex As Long) As Long Private Declare Function SetWindowLongA Lib "USER32" _ (ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Option Explicit Sub FormatUserForm(UserFormCaption As String) Dim hWnd As Long Dim exLong As Long hWnd = FindWindowA(vbNullString, UserFormCaption) exLong = GetWindowLongA(hWnd, -16) If (exLong And &H20000) = 0 Then SetWindowLongA hWnd, -16, exLong Or &H20000 Else End If End Sub هذا الكود في UserForm1Code Private Sub UserForm_Initialize() Call FormatUserForm(Me.Caption) End Sub Add Minimize Button To Userform.zip رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر أكتوبر 23, 2011 الكاتب مشاركة قام بنشر أكتوبر 23, 2011 كود الاحتواء التلقائي للورقة النشطة Public Sub AutoFitSheet() If ActiveWorkbook Is Nothing Then Exit Sub Dim i# If ActiveWindow.SelectedSheets.Count > 1 Then For i = 1 To ActiveWindow.SelectedSheets.Count ActiveWindow.SelectedSheets(i).Cells.EntireColumn.AutoFit Next Else Cells.EntireColumn.AutoFit End If End Sub رابط هذا التعليق شارك More sharing options...
أ / محمد صالح قام بنشر أكتوبر 23, 2011 مشاركة قام بنشر أكتوبر 23, 2011 بارك الله لك أخي محمد يحيى موضوع رائع واسمح لي بالمساهمة فيه ولو بالقليل ..... كود لعرض شريط القوائم وشريط الأدوات القياسي وشريط التنسيق (الخاصين بأوفيس 2003) في أوفيس 2007 أو 2010 في الإكسل نستعمل الكود التالي Sub show2003() On Error Resume Next Dim cb As CommandBar Dim ctrl As CommandBarControl Set cb = CommandBars.Add("Mas2003Menu") For Each ctrl In CommandBars("Worksheet Menu Bar").Controls ctrl.Copy cb Next ctrl cb.Visible = 1 Set cb = CommandBars.Add("Mas2003Standard") For Each ctrl In CommandBars("Standard").Controls ctrl.Copy cb Next ctrl cb.Visible = 1 Set cb = CommandBars.Add("Mas2003Formatting") For Each ctrl In CommandBars("Formatting").Controls ctrl.Copy cb Next ctrl cb.Visible = 1 End Sub وفي الوورد والباور بوينت نستعمل الكود التالي Sub show2003() On Error Resume Next Dim cb As CommandBar Dim ctrl As CommandBarControl Set cb = CommandBars.Add("Mas2003Menu") For Each ctrl In CommandBars("Menu Bar").Controls ctrl.Copy cb Next ctrl cb.Visible = 1 Set cb = CommandBars.Add("Mas2003Standard") For Each ctrl In CommandBars("Standard").Controls ctrl.Copy cb Next ctrl cb.Visible = 1 Set cb = CommandBars.Add("Mas2003Formatting") For Each ctrl In CommandBars("Formatting").Controls ctrl.Copy cb Next ctrl cb.Visible = 1 End Sub وهذا كود حذفهم جميعاً Sub hide2003() On Error Resume Next CommandBars("Mas2003Menu").Delete CommandBars("Mas2003Standard").Delete CommandBars("Mas2003Formatting").Delete End Sub تحياتي للجميع وكل عام أنتم بخير بمناسبة أفضل ايام الدنيا عشر ذي الحجة 2 رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر أكتوبر 24, 2011 مشاركة قام بنشر أكتوبر 24, 2011 وهذا كود تغير اسم الورقة النشطة Sub Renamed_SH() alidroos_sh = Application.Dialogs(xlDialogWorkbookName).Show End Sub 1 رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر أكتوبر 24, 2011 الكاتب مشاركة قام بنشر أكتوبر 24, 2011 الاخوة الافاضل : ابو الحارث سعد عابد محمود اشكركم جزيل الشكر الاستاذ الفاضل محمد صالح شكرا على الكود الجميل اخي الحبيب ابو نصار اشكرك على الكود الجميل ===================================== هذا ايضا كود تغيير حجم صورة بتغير قيمة خلية Option Explicit Option Compare Text Public ScrWidth&, ScrHeight& Declare Function GetSystemMetrics32 Lib "User32" _ Alias "GetSystemMetrics" (ByVal nIndex&) As Long Sub SizePic() Dim SizeFactor, x SizeFactor = Range("A1").Value ActiveSheet.Shapes(1).Width = SizeFactor * (GetSystemMetrics32(0)) End Sub تغيير حجم صورة حسب تغير قيمة خلية.rar 1 رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر أكتوبر 29, 2011 الكاتب مشاركة قام بنشر أكتوبر 29, 2011 كود مراجعة الصيغة في الخلية المحدة مراجعة الصيغ تحديد الخلايا.zip رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر أكتوبر 29, 2011 الكاتب مشاركة قام بنشر أكتوبر 29, 2011 بعض الدوال المهمة للرجوع الى ورقة عمل عن طريق الصيغ الرجوع إلى ورقة عمل من الصيغ.rar رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر نوفمبر 1, 2011 الكاتب مشاركة قام بنشر نوفمبر 1, 2011 كود لتثبيت وظيفة اضافية بفرض ان الملف هو MyAddIn.xla و ان مسار الملف هو C:\MyAddIn.xla Sub InstallAddIn() Dim AI As Excel.AddIn Set AI = Application.AddIns.Add(Filename:="C:\MyAddIn.xla") AI.Installed = True End Sub رابط هذا التعليق شارك More sharing options...
أ / محمد صالح قام بنشر نوفمبر 7, 2011 مشاركة قام بنشر نوفمبر 7, 2011 كود لتثبيت وظيفة اضافية بفرض ان الملف هو MyAddIn.xla و ان مسار الملف هو C:\MyAddIn.xla Sub InstallAddIn() Dim AI As Excel.AddIn Set AI = Application.AddIns.Add(Filename:="C:\MyAddIn.xla") AI.Installed = True End Sub بارك الله فيك أخي محمد يحياوي وهذا هو الكود العكسي إلغاء تثبيت وظيفة إضافية sub UnInstall_Addin() Dim oXLAddin As AddIn For Each oXLAddin In Application.AddIns If oXLAddin.FullName = "C:\MyAddIn.xla" Then oXLAddin.Installed = False End If Next oXLAddin End Sub وكل عام أنتم بخير 1 رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر نوفمبر 7, 2011 الكاتب مشاركة قام بنشر نوفمبر 7, 2011 الاخوة الافاضل سعد عابد جمال دغيدي شكرا جزيلا الاخ الفاضل محمد صالح شكرا على الكود الجميل ============================================== كود انشاء ملف وورد و تصدير بيانات اليه تصدير بيانات الى وورد.rar 1 رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر نوفمبر 10, 2011 الكاتب مشاركة قام بنشر نوفمبر 10, 2011 استدعاء بيانات من جدول قاعدة بيانات ضع قاعدة البيانات في مجلد المستندات ...يمكنك التعديل على اسماء الحقول المراد جلب بياناتها ... يمكنك التعديل على على مكان نسخ الجدول استدعاء بيانات من جدول قاعدة بيانات.rar 1 رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر نوفمبر 11, 2011 مشاركة قام بنشر نوفمبر 11, 2011 Sub open_Calculator_by_vba() Shell ("calc") End Sub كود لاظهار الآلة الحاسبة رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر نوفمبر 11, 2011 مشاركة قام بنشر نوفمبر 11, 2011 Sub open_notepad_by_vba() Shell ("notepad") End Sub كود لاظهار النوت باد notepad رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر نوفمبر 11, 2011 مشاركة قام بنشر نوفمبر 11, 2011 (معدل) وهذا الكود لفتح control panel Sub open_control_panel_by_vba() Shell ("control panel") End Sub تم تعديل نوفمبر 11, 2011 بواسطه دغيدى رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر نوفمبر 11, 2011 مشاركة قام بنشر نوفمبر 11, 2011 إدراج صف فارغ عند تغيير البيانات في عمود منقول إدراج صف فارغ.rar رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر نوفمبر 11, 2011 مشاركة قام بنشر نوفمبر 11, 2011 لمعرفة عدد ايام شهر محدد ( معين ) =DAY(DATE(YEAR(A2);MONTH(A2)+1;DAY(1))-1) رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر نوفمبر 11, 2011 مشاركة قام بنشر نوفمبر 11, 2011 (معدل) Sub deletshape() Dim sh As Shape For Each sh In activesheet.Shapes If sh.Type = msoPicture Then sh.Delete End If Next sh End Sub حذف جميع الصور الموجودة فى الصفحة النشطة تم تعديل نوفمبر 11, 2011 بواسطه دغيدى رابط هذا التعليق شارك More sharing options...
محمد يحياوي قام بنشر نوفمبر 11, 2011 الكاتب مشاركة قام بنشر نوفمبر 11, 2011 الاخوة الافاضل في منتدانا الحبيب تسهيلا على الاخوة الكرام في متابعة الموضوع و اكواده قمت بعمل الجزء الثالث من الفهرس و هو ملف pdf l نظرا لكثرة مشاركات الاخوة الكرام جزاهم الله خيرا لم استطع ادراجها في الموضوع فهرس 3 من موضوع الاكواد المنفصلة.rar رابط هذا التعليق شارك More sharing options...
دكتور محمد صلاح قام بنشر نوفمبر 12, 2011 مشاركة قام بنشر نوفمبر 12, 2011 تريد ان تبحث عن كلمة او نص في خلية في ورقة او في جميع اوراق المصنف ... تحصل على جميع نتائج البحث في ورقة جديدة مع جميع ارتباطات الخلايا محل البحث بحث عن.rar 19.41K 31 عدد مرات التحميل الاخ اتلكريم جزاكم الله خيرا على ما قدمتموة فحقيقة تعلمت الكثير هنا وهذا الكود رائع ولكن اطمع فى المزيد ان يكون ناتج البحث فى الشيت الجديد ليس الخلية فقط بل الصف بالكامل الذى يحتوى على الخلية ليكون بمثابة تقرير احترامى للجميع دكتور محمد صلاح رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر نوفمبر 12, 2011 مشاركة قام بنشر نوفمبر 12, 2011 Sub change_sheet_tab_color() ActiveWorkbook.Sheets(1).Tab.ColorIndex = 0 ActiveWorkbook.Sheets(2).Tab.ColorIndex = 1 ActiveWorkbook.Sheets(3).Tab.ColorIndex = 2 ActiveWorkbook.Sheets(3).Tab.ColorIndex = 3 ActiveWorkbook.Sheets(4).Tab.ColorIndex = 4 End Sub كود تلوين تبويبات الأوراق غير فى أرقام الألوان ولاحظ ملحوظة : يجب أن يكون الكود مناسبا للعدد الأوراق كود تلوين تبويبات الأوراق.rar رابط هذا التعليق شارك More sharing options...
الردود الموصى بها