(موضوع مميز ) بعض الاكواد المنفصلة قد تهم البعض

**الـعيدروس** · أكتوبر 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

تحياتي

**محمد يحياوي** · أكتوبر 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

**KHMB** · أكتوبر 19, 2011

السلام عليكم ورحمة الله وبركاتة

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

اخي ياريت إن امكن شرح الفائدة لكل زر امر

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

او تحتها او يمينها او يسارها وهذا جميل جدا ورائع باقي معرفة البعض الآخر مثل الثابتة او التي تتمركز في اليمين وتثبت اينما كانت

شاكراً لكم سلفاً

**محمد يحياوي** · أكتوبر 19, 2011

الاخ الكريم يمكنك اضافة اي رقم الى كلمتي (Top - Left) مثلا +20 او +40 و لاحظ الفرق

**دغيدى** · أكتوبر 20, 2011

أخى الفاضل / يجيــــاوى

سلام الله عليكم

كما أنتم دائمـــا..أدام الله عليكم نعمة العلم

بعد إذنكم قمت بوضعهم جميعا فى ملف واحد

Freeze CommandButton.rar

**محمد يحياوي** · أكتوبر 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

**محمد يحياوي** · أكتوبر 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

**أ / محمد صالح** · أكتوبر 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

تحياتي للجميع

وكل عام أنتم بخير بمناسبة أفضل ايام الدنيا

عشر ذي الحجة

**الـعيدروس** · أكتوبر 24, 2011

وهذا كود تغير اسم الورقة النشطة


Sub Renamed_SH()

alidroos_sh = Application.Dialogs(xlDialogWorkbookName).Show

End Sub

**محمد يحياوي** · أكتوبر 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

**محمد يحياوي** · أكتوبر 29, 2011

كود مراجعة الصيغة في الخلية المحدة

مراجعة الصيغ تحديد الخلايا.zip

**محمد يحياوي** · أكتوبر 29, 2011

بعض الدوال المهمة للرجوع الى ورقة عمل عن طريق الصيغ

الرجوع إلى ورقة عمل من الصيغ.rar

**محمد يحياوي** · نوفمبر 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

**أ / محمد صالح** · نوفمبر 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

وكل عام أنتم بخير

**محمد يحياوي** · نوفمبر 7, 2011

الاخوة الافاضل

سعد عابد

جمال دغيدي

شكرا جزيلا

الاخ الفاضل محمد صالح شكرا على الكود الجميل

==============================================

كود انشاء ملف وورد و تصدير بيانات اليه

تصدير بيانات الى وورد.rar

**محمد يحياوي** · نوفمبر 10, 2011

استدعاء بيانات من جدول قاعدة بيانات

ضع قاعدة البيانات في مجلد المستندات ...يمكنك التعديل على اسماء الحقول المراد جلب بياناتها ... يمكنك التعديل على على مكان نسخ الجدول

استدعاء بيانات من جدول قاعدة بيانات.rar

**دغيدى** · نوفمبر 11, 2011


Sub open_Calculator_by_vba()

Shell ("calc")

End Sub

كود لاظهار الآلة الحاسبة

**دغيدى** · نوفمبر 11, 2011


Sub open_notepad_by_vba()

Shell ("notepad")

End Sub

كود لاظهار النوت باد notepad

**دغيدى** · نوفمبر 11, 2011

وهذا الكود لفتح control panel


Sub open_control_panel_by_vba()

Shell ("control panel")

End Sub

تم تعديل نوفمبر 11, 2011 بواسطه دغيدى

**دغيدى** · نوفمبر 11, 2011

إدراج صف فارغ عند تغيير البيانات في عمود

منقول

إدراج صف فارغ.rar

**دغيدى** · نوفمبر 11, 2011

لمعرفة عدد ايام شهر محدد ( معين )


=DAY(DATE(YEAR(A2);MONTH(A2)+1;DAY(1))-1)

**دغيدى** · نوفمبر 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 بواسطه دغيدى

**محمد يحياوي** · نوفمبر 11, 2011

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

فهرس 3 من موضوع الاكواد المنفصلة.rar

دكتور محمد صلاح · نوفمبر 12, 2011

تريد ان تبحث عن كلمة او نص في خلية في ورقة او في جميع اوراق المصنف ...

تحصل على جميع نتائج البحث في ورقة جديدة مع جميع ارتباطات الخلايا محل البحث

بحث عن.rar 19.41K 31 عدد مرات التحميل

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

دكتور محمد صلاح

**دغيدى** · نوفمبر 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

تسجيل الدخول

(موضوع مميز ) بعض الاكواد المنفصلة قد تهم البعض

الردود الموصى بها

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

محمد يحياوي

ياسر الحافظ

محمد يحياوي

Posted Images

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information