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

[محمد يحياوي]

الاخ الحبيب "الحسامي" اشكرك جزيل الشكر على كبير كرمك و سعة صدرك

و هذا الجزء الاول و الجزء الثاني من فهرس الموضوع

الجزء 1 من فهرس موضوع الاكواد المنفصة.rar

الجزء 2 من فهرس موضوع الاكواد المنفصة.rar

[اساامه]

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

الف شكر للجميع على المعلومات الجميله والرائعه وعلى جهودهم الطيبه في هذا الموقع القدير

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

اتمنى ان يكون التفيذ صحيحا لدي .

تحديث ومعاينه قبل الطباعه.rar

[محمد يحياوي]

اخواني الكرام جزاكم الله خيرا كان هناك احد الاخوة طرح سؤالا في ما يخص ملف البحث عن على الرابط التالي وذلك لاستخراج بيانات السطر كله (حتى العمود H) اثناء البحث و هذا تعديل للملف

بحث عن.rar

[الـعيدروس]

السلام عليكم

استاذنا الحبيب يحياوي اسعد الله مساك

الاخوة الاحبه مسائكم فل وياسمين

نأتيكم مابجعبتنا كود لإخفاء القوائم تماماً

هذا الكود للإخفاء ندرج قيمة FALSE

Sub hid_koaeem()

Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)"

End Sub

وفي حالة الإظهار ندرج قيمة true هكذا

Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",true)"

والسلام عليكم

[الـعيدروس]

السلام عليكم

سبق وان طرح استاذنا القدير دغيدي كود لحذف الصور في الورقة النشطه

وهذا كود لحذف الصور في جميع الاوراق

Option Explicit

Sub delet_Pict()

Application.ScreenUpdating = False

Application.EnableEvents = False

  Dim myPict As Picture

  Dim s

  For s = 1 To Sheets.Count

  For Each myPict In Sheets(s).Pictures

	  myPict.Delete

  Next myPict

  Next s

End Sub

والسلام عليكم

[محمد يحياوي]

كود لاضافة زر تصغير لليوزرفورم

Add Minimize Button To Userform.zip

[أ / محمد صالح]

كود لاضافة زر تصغير لليوزرفورم

بارك الله لك أخي محمد يحياوي

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

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

أترككم مع المرفق

الذي يجعل نماذجكم قمة في الروعة

UserFormControl.rar

[محمد يحياوي]

معرفة وقت اخر مرة تم فيها الدخول الى الجهاز

Windows LastLogin times.rar

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

اخواني الكرام جزاكم الله خيرا كان هناك احد الاخوة طرح سؤالا في ما يخص ملف البحث عن على الرابط التالي وذلك لاستخراج بيانات السطر كله (حتى العمود H) اثناء البحث و هذا تعديل للملف

بحث عن.rar

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

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

[الـعيدروس]

السلام عليكم

كود لفتح باسورد محرر الأكواد

تحط الأكواد في مدويل

Sub PAS_ACTIVEBOOK()

    Call UnprotectVBProj1("123")

End Sub

Sub UnprotectVBProj1(ByVal Pwd As String)

    Dim vbProj As Object

    Set vbProj = ThisWorkbook.VBProject

    If vbProj.Protection <> 1 Then Exit Sub '

    Set Application.VBE.ActiveVBProject = vbProj

    SendKeys Pwd & "~~"

    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

End Sub

وكإختصار يمكن فتح الباسور عن طريق زر فليكن F7 مثلا هكذا تحط الكود في مدويل

Sub Auto_Open()

Application.OnKey "{F7}", "PAS_ACTIVEBOOK"

End Sub

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

Sub PAS_WBOOK()

    Dim WB As Workbook

    For Each WB In Application.Workbooks

	    If Not WB.Name = ThisWorkbook.Name Then Call UnprotectVBProj(WB, "123")

    Next WB

End Sub

Sub UnprotectVBProj(ByRef WB As Workbook, ByVal Pwd As String)

    Dim vbProj As Object

    Dim OpenWindow As Object

    For Each OpenWindow In Application.VBE.VBProjects.VBE.Windows

	    If InStr(1, OpenWindow.Caption, "(Code)") > 0 Then OpenWindow.Close

    Next

    DoEvents

    Set vbProj = WB.VBProject

    If vbProj.Protection <> 1 Then Exit Sub

    Set Application.VBE.ActiveVBProject = vbProj

    DoEvents

    SendKeys Pwd & "~~"

    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

End Sub

وهذا إختصار لعمل الكود F5

Sub Auto_Open()

Application.OnKey "{F5}", "PAS_WBOOK"

End Sub

[الـعيدروس]

السلام عليكم

كود لتكبر وتصغير وإستعادة وتحجيم يدوي بالماوس للفورم

هذا في حدث الفورم

Private Sub UserForm_Activate()

A_FR Me

End Sub

وهذا في مودويل

Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Public old_largeur As Long, handle As Long, old_hauteur As Long, newhauteur As Single, newlargeur As Single

Sub A_FR(A As UserForm)

  old_largeur = A.InsideWidth: old_hauteur = A.InsideHeight

  handle = FindWindow("Thunder" & IIf(Application.Version Like "8*", "0*", "D") & "Frame", A.Caption)

  SetWindowLong handle, -16, GetWindowLong(handle, -16) Or &HC70000

  End Sub

[الـعيدروس]

السلام عليكم

كود طباعة مدى متفرق إستعن بزر كنترول Ctrl للتحديد

Sub Print_A()

' كود طباعة مدى متفرق

Dim MY_ALI As Range, XX_ALI As Range

Dim I_ALI As Integer

With Application

.DisplayAlerts = False

Set MY_ALI = .InputBox(prompt:="حدد المدى المترفق الإستعانه بزر Ctrl", Type:=8)

.ScreenUpdating = False

Worksheets.Add

End With

With ActiveSheet

For Each XX_ALI In MY_ALI.Areas

XX_ALI.Copy

Cells(Range("A1").SpecialCells(xlLastCell).Row + I_ALI, 1).Select

I_ALI = 1

.Paste

Next

.PrintPreview

.Delete

End With

End Sub

[محمد يحياوي]

الاخ الفاضل ابو نصار عطاء بلا حدود و اكواد جميلة

[AL_AYMAN]

استاذي العزيز " يحيــــــــــــــــــــــاوي "

مرفق ملف

كود للتنقل بين اوراق العمل ( هذا الكود له مشاركة مشابهة نوعا ما ) ولكن هذه المرة

بعض الاوراق ( ويمكن تحديدها من الكود ) لا تظهر فى القائمة من اعمال اخونا الاستاذ " عبد الله المجرب " ابو احمد

وفقك الله

ياسر الحافظ " ابو الحارث "

[mhrrd]

بارك الله لكم

[m_ahmed]

بارك الله فيك

[اوفيس 2003]

عمل اكثر من رائع

[zizou144]

ماشاء الله عمل أكثر من رائع جزاكم الله شكراً و صحة ودمتم لمنتدانا الغالي

[Akram Galal]

أخوتي الأعزاء

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

[محمد يحياوي]

اخواني جزاكم الله خيرا على اثراء الموضوع و تقبل الله منا ومنكم صالح الاعمال

[يوسف السيد]

ما شاء الله ابداع متواصل ... جزاكم الله خيرا ...... وننتظر المزيد

[يوسف عطا]

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

مرفق الملف

محفظة اكواد_النسخة1.rar

[الزريقي ق]

ماشاء الله عمل أكثر من رائع .. جزاكم الله خيراً ، وأثقل الله ميزاننا وميزانكم بالحسنات يوم العرض عليه ، كما أثقلتم المنتدى بوافر المعلومات القيـــمة..

ودمـتم اهلاً للـخيــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــر،،،،،

[حمادة عمر]

ماشاء الله عمل أكثر من رائع

الاستاذ - القدير يحياووووووووووووووووي

فكرة رائعة لقد استفاد منها بالطبع الكثيرين جدا جدا

ولا يسعني الا ان اقول لك جزاك الله خيرا

ولكل الاساتذة الذين ساهموا في هذا الموضوع وفي هذا المنتدي بالكامل

جزاكم الله شكراً و صحة ودمتم لمنتدانا الغالي

[أ/حكيم]

 ماشاء الله على هذا الابداع شكراً للجميع وبارك الله فيكم