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

[ياسر الحافظ]

العزيز يحياوي :

مرفق كود :

كود احتساب الاستحقاق بين تاريخين + احتساب المطلوب الصافي

من اعمال الاستاذ - يحيى حسين - بتصرف " ياسر "

وفقك الله

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

كود استخلاص مستحقات ومطلوب.rar

[ياسر الحافظ]

اخي واستاذي العزيز يحياوي :

مرفق كود :

كود ترحيل ( كود نقل بيانات مباشرة بدون زر امر ) - يتم الترحيل بمجرد كتابة الكلمة المطلوبة

من اعمال الاستاذ - HaNcOk - " احمد فضيلة "

وفقك الله

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

كود نقل بيانات مباشرة بدون رز امر.rar

[عبدالله المجرب]

كود لنقل البيانات من اعمده الى صفوف بتكرار معين (من اعداد الاستاذ الفاضل ابو عمر (كيماس))

Sub Macro2()

'

'

Dim k As Long

'

Application.ScreenUpdating = False

Range("d6:g500").ClearContents

    Range("B6:B16").Copy

    Range("E6").Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

        False, Transpose:=True

        k = 7

        For i = 1 To 1000 Step 11

    Range("C" & i + 5 & ":C" & i + 15).Select

    Selection.Copy

    Range("E" & k).Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

        False, Transpose:=True

        k = k + 1

    Next i

        Application.CutCopyMode = False

        Range("a1").Select

        Application.ScreenUpdating = True

End Sub

[عبدالله المجرب]

كود لحذف الخلايا الفارغة في عمود بيانات من اعدادي حسب طلب احد الاخوة

Sub حامل_المسك()

    Range("B1:C1000").Select

    Selection.SpecialCells(xlCellTypeBlanks).Select

    Selection.EntireRow.Delete

    Range("A1").Select

End Sub

[عبدالله المجرب]

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

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

في الرابط

http://www.officena.net/ib/index.php?showtopic=37767

[ياسر الحافظ]

العزيز يحياوي :

مرفق ملف ... كود رفعه الاستاذ عبد الله المجرب " ابو احمد " بمشاركته رقم 302 ( مع كل الشكر اخي واستاذي ابو احمد )

كود لنقل البيانات من اعمده الى صفوف بتكرار معين (من اعداد الاستاذ الفاضل ابو عمر (كيماس))

وفقك الله

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

كود لنقل البيانات من اعمده الى صفوف.rar

[ياسر الحافظ]

العزيز يحياوي :

مرفق ملف ... كود رفعه الاستاذ عبد الله المجرب " ابو احمد " بمشاركته رقم : 303

كود لحذف الخلايا الفارغة في عمود بيانات (من اعداد الاستاذ الفاضل ابو احمد (عبد الله المجرب ))

وفقك الله

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

كود لحذف الخلايا الفارغة في عمود بيانات.rar

[ياسر الحافظ]

الاخ خالد : ( بعد العذر من الاستاذ محمد يحياوي )

عذرا ... كما اجابك الاستاذ عبد الله المجرب " ابو احمد "

ارفع سؤالك بموضوع مستقل .... فهذا الموضوع مخصص لعرض الاكواد ...

وعندما ترفع موضوعك بشكل مستقل ستجد اكثر من اجابة من الاساتذة في المنتدى

وعلة اية حال يمكنك البحث في المنتدى وستجد ضالتك انشاء الله

كود بحث في النتدى لاستاذ يحياوي

وفقك الله

ياسر الحافظ

[ياسر الحافظ]

العزيز يحياوي :

مرفق ملف

كود احترافي ... رائع جدا

لتلوين التشكيل في خلية اكسل " او مدى معين "

من اعمال الاستاذ الكبير " استاذنا " محمـــــــــــــــــــــــــــــــد طاهر " مدير الموقع "

وفقك الله

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

ColorTashkil.rar

[عبدالله باقشير]

السلام عليكم

كود لاظهار واخفاء الاعمدة

امر واحد يعكس العملية

وممكن استخدامه في اكثر من خاصية مشابهة

Sub kh_Hidden()

With Range("F1,K1,P1,U1,Z1")

    .EntireColumn.Hidden = Not .EntireColumn.Hidden

End With

End Sub

[ياسر الحافظ]

السلام عليكم

كود لاظهار واخفاء الاعمدة

امر واحد يعكس العملية

وممكن استخدامه في اكثر من خاصية مشابهة

العزيز يحياوي :

مرفق ملف اكسل لكود استاذنا الكبير خبـــــــــــــــــور خير

وفقك الله

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

كود اظهار واخفاء الاعمدة.rar

[ياسر الحافظ]

العزيز يحياوي :

مرفق ملف

كود يتم من خلاله مقارنة البيانات في عامويدن وتلوين المكرر بينهما .......مع رسالة بعدد القيم المكررة - من اعمال الاستاذ " العينبوســـــــــــــــــي "

الواقع هما 2 كود ( تتضمن حالتين )

وفقك الله

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

مقارنة بين عامودين وتلوين المكرر.rar

[عبدالله باقشير]

السلام عليكم

كود لالتقاط صورة للشاشة

Sub PrintTheScreen()

Application.SendKeys "(%{1068})"

DoEvents

End Sub

[عبدالله باقشير]

السلام عليكم

كود لاظهار الرسام

mspaint

Sub kh_mspaint()

Dim ReturnValue

ReturnValue = Shell("c:\windows\system32\mspaint.exe", 3)

End Sub

[ياسر الحافظ]

العزيز يحياوي :

ارفق ملف واحد :

كود - التقاط صورة للشاشة -

كود - اظهــــــــــــــــــــار الرسام -

من اعمال استاذنا الكبير " خبــــــــــــــــــــور خير " في مشاركاته رقم " 324 + 324 "

وفقك الله

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

كود التقاط صورة + اظهار الرسام.rar

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

اخواني الكرام تحية طيبة بمناسبة قدور شهر رمضان المبارك اعاده الله على الامة الاسلامية بالخير و البركة و تقبل الله منا ومنكم صالح الاعمال

كود لفتح منتدى الاكسل في منديات اوفيسنا

كود فتح منتدى اوفيسنا.rar

[عبدالله المجرب]

كود يوضع في زر امر لحذف الصفوف التي بها ارقام لا تبداء ب 3

Sub ss()

Application.ScreenUpdating = False

For i = 5 To 100

If Mid(Cells(i, 1), 1, 1) <> 3 Then

Cells(i, 1).Value = ""

End If

Next i

Range("A5:A100").Select

    Selection.SpecialCells(xlCellTypeBlanks).Select

    Selection.EntireRow.Delete

 Range("A1").Select

 Application.ScreenUpdating = True

End Sub

بفرض ان الارقام في العمود A في المجال A5:A100

ويمكن زيادة المدى

المرفق 2007 2003

والله اعلم

حذف الصفوف التي لا تبداء برقم معين.rar

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

كود فتح ملف موجود في المستندات

open file.rar

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

كود حفظ ملف باسم في مجلد المستندات

save file.rar

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

كود تعطيل قائمة زر الماوس الايمن

Sub DisableAllShortcutMenus()

Dim cb As CommandBar

For Each cb In CommandBars

If cb.Type = msoBarTypePopup Then _

cb.Enabled = False

Next cb

End Sub

DisableAllShortcutMenus.rar

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

كود لتحويل المعادلات الى قيم للاستاذ الفاضل "خبور خير" بارك الله فيه.

Option Explicit



Sub Kh_Formula_To_Value()

Dim MyCalcu As XlCalculation

With Application

    MyCalcu = .Calculation

    .Calculation = xlCalculationManual

    .ScreenUpdating = False

End With

'=====================================

'//////////////////////////////////////

'=====================================

'  هنا تضع النطاق والمعادلة التي تريد تحويلها قيم

'      Formula_To_Value باستخدام

'=====================================

' T هنا المعادلة اللي في العمود

Formula_To_Value Range("T5:T30"), "=RC[-2]*RC[-1]"


' x هنا المعادلة اللي في العمود

'  مثل عمل كود الاخ كيماس


Formula_To_Value Range("X5:X30"), "=IF(COUNTIF(RC16:R30C16,RC16)=1,SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20)),"""")"


' Y هنا المعادلة اللي في العمود

Formula_To_Value Range("Y5:Y30"), "=SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20))"

'=====================================

'//////////////////////////////////////

'=====================================

With Application

    .ScreenUpdating = True

    .Calculation = MyCalcu

End With


End Sub

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


Sub Formula_To_Value(MyRng As Range, MyFormula As Variant)

With MyRng

    .ClearContents

    .Formula = MyFormula

    .Cells = .Value

End With

End Sub

كود تحويل المعادلات الى قيم.rar

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

كود اظهار نافذة محرر الاكواد VBE

VBE Visible.rar

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

كود لفتح و ارجاع قارئ الاقراص

Open Close CD Door.rar

[ياسر الحافظ]

العزيز يحيـــــــــــــــــــــــــــــــــــــاوي :

مرفق ملف

إضافة شيت جديد بحيث يقوم المستخدم بتحديد إسم الشيت في ظل ان يكون هذا الإسم اقل من او يساوي 31 حرف كذلك يجب الا يكون اسم الشيت مكرر

من اعمال اخونا العزيز / الاستاذ " معتصــــــــــــــــــــــــــم محمد "

وفقك الله

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

كود اضافة شيت جديد.rar

[ياسر الحافظ]

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

مرفق ملف

كود استخص اجندة ( مفكرة سنوية ) ( رزنامة ) في صفحة اكسل

اتمنى ان ينال الرضى

وفقك الله

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

كود تقويم سنوي.rar