اكواد اكسل رائعة

[قنديل الصياد]

جزاك الله كل خير

[قنديل الصياد]

انشاء دالة للجمع باسمك

Function kandeel(a As Integer, b As Integer) As Integer
kandeel = a + b
End Function

انشاء دالة للقسمة

Function division(x, y)
    If y > 0 Then
        division = x / y
    Else
        division = "division impossible"
    End If
End Function 

مرفق ملف به الاكواد

 

قنديل__.rar

تم تعديل يناير 4, 2014 بواسطه قنديل الصياد

[قنديل الصياد]

كود لاضافة اسم نطاق استنادا الى مجموعة

 

شرح فيديو + ملف به الكود + الكود المستخدم

Sub قنديل()
    Selection.Name = " الأسماء"
End Sub

 

 

 

 

 

Book1.rar

[قنديل الصياد]

كود لتسمية مجموعة خلايا محددة

Sub DefineName1()
 Range("A3:B5").Name = "الصياد"
  Debug.Print Range("الصياد").Address(External:=True)
End Sub

[قنديل الصياد]

كود لطباعة مدى من الخلايا تقوم بتحديده

Sub طباعة()
Range("a4:f24").Select
Selection.PrintOut copies:=1, preview:=True, collate:=True
A = MsgBox("هل تود طباعة التحديد الذى عاينته؟", vbYesNo + vbQuestion, "طباعة")
If A = vbYes Then
With ActiveSheet
.PrintOut
End With
End If
End Sub

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم

الاخ العزيز قنديل الصياد

تجميعه رائعه وسيل من الاكواد التى تفيد الجميع

جزاك الله كل الخير

[حليم ناصر]

 بارك الله فيك وفى جميع اعمالك

[جلال الجمال_ابو أدهم]

بارك الله فيك

[قنديل الصياد]

السلام عليكم

الاخ العزيز قنديل الصياد

تجميعه رائعه وسيل من الاكواد التى تفيد الجميع

جزاك الله كل الخير

[قنديل الصياد]

 بارك الله فيك وفى جميع اعمالك

[قنديل الصياد]

بارك الله فيك

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

جزاك الله خيرا اخي وتنمى من الله ان يوفقكم لاستكمال هذا العمل الرائع ... سلمت يمينك

[قنديل الصياد]

[حمادة عمر]

مجهود ممتاز و رائع

جزاك الله خيرا

[قنديل الصياد]

شكرا استاذى الحبيب

وجزاك الله خيرا

[أبوحسام 1]

شكرا وجزاك الله كل خير الاكواد لو تستمرون في انتاج اكواد اخرى

[أبو إلياس السوري]

بارك الله فيكم ..هذا المنتدى إفادة في إفادة

[قنديل الصياد]

كود لابجدة الاناث وابجدة الذكور

 

 ابجدة الاناث اولا

ابجدة الذكور اولا

مرفق ملف به الاكواد

 

أبجدة.rar

 

[ا بو سليمان]

بااااااااااارك الله فيك اخي العزيز

[أبوحسام 1]

سلمت يمناك على تفاعلك ويعطيك العافية

[قنديل الصياد]

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

 

مرفق ملف به الكود

 

 

مسح البيانات.rar

 

 

 

[علاء رسلان]

السلام عليكم

الأخ الفاضل و الأستاذ الكريم قنديل الصياد متابع لموضوعكم الرائع و لدى تساؤلات حول بعض الاكواد

التى لم استطيع التوصل لعملها فهل يمكننى طرح تساؤلاتى هذه بعد أذنك بموضوعك فربما لديك ما يحسم الامر

ان كان يمكن فعلها ام لا ؟ مع جزيل الشكر

دمت بخير و أعزك الله

[ياسر خليل أبو البراء]

أخي الحبيب علاء رسلان

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

مجرد رأي : لما لا تطرح موضوعاً بكل مسألة يلتبس عليك الأمر فيها أو تريد إضافة محددة أو خلافه

أعتقد هذا يثري المنتدى بشكل أكبر

[قنديل الصياد]

كل عام وحضراتكم بخير ونحن دائما مع كل جديد وكل تساؤل لاننا نستفيد ونفيد من خبرات اساتذتنا الكرام فى هذا الصرح العظيم

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

[Archer]

On 1/3/2014 at 1:40 PM, قنديل الصياد said:

انشاء ملف Word بنفس القيم الموجودة فى ملف الاكسيل

Sub proWord()
Dim varDoc As Object

        Set varDoc = CreateObject("Word.Application")

                  varDoc.Visible = True
                  Sheets("ورقة1").Range("A1:B15").Copy
                  varDoc.documents.Add
                  varDoc.Selection.Paste
                  varDoc.activedocument.SaveAs ThisWorkbook.Path & "/" & "منتديات اوفيسنا.doc"
                  varDoc.documents.Close

        varDoc.Quit
         Application.CutCopyMode = False
End Sub

جمع اكثر من خلية فى خلية

Sub جمع()
Range("h9").Value = Application.WorksheetFunction.Sum(Range("e7:g9"))
End Sub

جمع عمود فى خلية

Sub جمع_عمود()
Range("d5").Value = Application.WorksheetFunction.Sum(Range("d1:d4"))
End Sub

تحديد مجموعة خلايا

Sub شكلبيضوي8_نقر()
Range("A1:G5").Select
End Sub

مرفق ملف به كل الاكواد

 

123.rar

السلام عليكم

 

فى حد موجود

 

اريد مساعدة ممكن حد يرد على

 

ايه معنى الكود التالى 

 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Variant
Dim dat As Variant
On Error GoTo ExitPoint

If Intersect(Target, Range("B5:E6,AL5:AO6")) Is Nothing Then Exit Sub
Application.EnableEvents = False

If Target.Cells.Count > 1 Then
dat = Target

For Each cl In dat
If cl = "" Then
Application.Undo

MsgBox "ÍÐÝ ãÍÊæíÇÊ åÐå ÇáÎáÇíÇ ÞÏ íÄÏí áÊáÝ åÐÇ ÇáãáÝ " & vbCrLf & _
"íãßäß ÇáÊæÇÕá ãÚ ãÓÆæá ÇáÈÑäÇãÌ ÅÐÇ ÑÛÈÊ Ýì ÊÛíÑ ÇáÈíÇäÇÊ ÈåÐå ÇáÎáÇíÇ", _
vbMsgBoxRight + vbCritical, "   ÊäÈíÜÜÜå ãåã   "

GoTo ExitPoint
End If
Next
End If
If Len(Trim(Target)) = 0 Then
Application.Undo

MsgBox "ÍÐÝ ãÍÊæíÇÊ åÐå ÇáÎáíÉ ÞÏ íÄÏí áÊáÝ åÐÇ ÇáãáÝ" & vbCrLf & _
"íãßäß ÇáÊæÇÕá ãÚ ãÓÆæá ÇáÈÑäÇãÌ ÅÐÇ ÑÛÈÊ Ýì ÊÛíÑ ÇáÈíÇäÇÊ ÈåÐå ÇáÎáíÉ", _
vbMsgBoxRight + vbCritical, "   ÊäÈíÜÜÜå ãåã   "

End If
ExitPoint:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Activate()
Call Replace_Two_Range
End Sub