اكواد اعجبتنى

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

الكود الأول

عبارة عن مسج  

Private Sub CommandButton1_Click()
 MsgBox "قنديل الصياد يرحب بكم فى منتديات أوفيسنا وكل عام وانتم بخير بمناسبة شهر رمضان المبارك أعاده الله علينا وعلى الامة الاسلامية بالخير واليمن والبركات"
End Sub

الكود الثانى

كتابة فى خلية من خلال فورم

Sub GetData()
Sales = InputBox(Prompt:="Enter Target Sales")

If Sales = "" Then Exit Sub

Range("B2").Value = Sales

End Sub

مرفق ملف به التطبيق

Book1.rar

 

 

 

[Hamzah077]

جزاك الله خير

[هاني عدلي]

أخي العزيز

قنديل الصياد

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

===========

أستاذ قنديل  .... لاحظت وجود أكثر من موضوع لك في المنتدي بأسم

أكواد أعجبتني

ما رأيك في ضم تلك المواضيع معاً في موضوع واحد

حتى يسهل الوصول لها

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

  هذه مجرد فكرة   

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

مجهود وافر  ..... عطاء كبييييييير

تقبل خالص تحياتي

     

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

جزاك الله خيرا اخى واستاذى العزيز

ودائما افكارك رائعة ومثمرة وجميلة

وساقوم بتنفيذها

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

سلسلة أكواد أعجبتنى

 

كود لإظهار الشيتات المخفية

 

كود لمعرفة رقم العمود ورقم الصف واسم الخلية التى تقف بها

 

كود لاستخراج عدد أوراق العمل بالملف

كود اعجبنى

 

مجموعة اكواد اعجبتنى

 

أكواد أعجبتنى

 

 

[هاني عدلي]

عمل رائـــــــــــــــــــع أخي قنديل

 

بارك الله فيك

======

خالص تحياتي

 

 

[Abdelhady Tahoon]

الاخ الفاضل قنديل الصياد كل عام ومعاليك بخير اعاد الله عليك شهر رمضان بالخير لو سمحت ترسل لى كود عمل دوائر حمراء فى شيت كنترول  على ايميلى وهو abdelhady.tahoon72@yahoo.com   ولسيادتك جزيل الشكر والتقدير

[حمادة عمر]

[عبد الحميد شقير]

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

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

امتدادا لسلسلة أكواد أعجبتنى

 

كود لجمع عمود اقوم بتحديده

Sub formulacopy()
Range("f2:f7").Formula = "=SUM(A2,B2,C2,D2,E2)"
End Sub

مرفق ملف به التطبيق

 

الصياد.rar

 

 

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

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

Sub Macro1()
Range("A11").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
Range("A12").Select
End Sub

مرفق ملف به التطبيق

 

الصياد.rar

 

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

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

 

الكود الاول : ادراج اشكال تلقائية

Sub btnShowAllAutoShapes_Click()
  Dim i&
  On Error Resume Next
  For i = 0 To 136
    ActiveSheet.Shapes.AddShape i + 1, 40 + 50 * (i Mod 12), 50 + 50 * (i \ 12), 40, 40
    Next
End Sub

الكود الثانى : ادراج شكل تلقائي عل شكل مستطيل

Sub AddRectangle()
 With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 200, 100).TextFrame
        .Characters.Text = "This is a rectangle"
        .HorizontalAlignment = xlHAlignCenter
        .VerticalAlignment = xlVAlignCenter
    End With
End Sub

الكود الثالث : ادراج شكل تلقائي على شكل نجمة

Sub btnStar_Click()
  Dim degree#
  Dim s As Shape
  Const Pi = 3.1415927
  Randomize
  For degree = 0 To 2 * Pi Step Pi / 12
    Set s = ActiveSheet.Shapes.AddLine(200, 200, 200 + 100 * Sin(degree), 200 + 100 * Cos(degree))
    s.Line.EndArrowheadStyle = msoArrowheadTriangle
    s.Line.EndArrowheadLength = msoArrowheadLengthMedium
    s.Line.EndArrowheadWidth = msoArrowheadWidthMedium
    s.Line.ForeColor.RGB = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
  Next
End Sub

الكود الرابع : حذف الاشكال التلقائية

Sub btnDeleteShapes_Click()
  Dim s As Shape
  For Each s In ActiveSheet.Shapes
    If s.Type = msoAutoShape Or s.Type = msoLine Then s.Delete
  Next
End Sub

الكود الخامس : فتح ملفات اكسيل الموجودة على جهازك

Sub LoadExcelFile()
  Dim result As Variant
  result = Application.GetOpenFilename("Excel files,*.xl?", 1)
  If result = False Then Exit Sub
  Workbooks.Open result
End Sub

مرفق ملف به التطبيق على الاكواد الخمسة

 

اكواد.rar

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

كود لعمل احتواء تلقائي للاعمدة والخلايا

Sub FormatCell()
'  Dim myVar As Range
    Set myVar = Selection
    With myVar
        .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
        .Columns.AutoFit
    End With
End Sub

مرفق ملف به التطبيق

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

 

عتت.rar

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

كود لنقل نص او رقم فى خلية الى تطبيق جديد اخر من اكسل

Sub LateBinding()

    'Declare a generic object variable
    Dim objExcel As Object

    'Point the object variable at an Excel application object
    Set objExcel = CreateObject("Excel.Application")

    'Set properties and execute methods of the object
    With objExcel
        .Visible = True
        .Workbooks.Add
        .Range("A1") = "مرحبا بكم فى منتديات اوفيسنا"
    End With

End Sub

مرفق ملف به التطبيق

 

Book1.rar

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

كود لتحديد عمود بأكمله

Sub SelectEntireColumn()
     Selection.EntireColumn.Select
End Sub

كود لعمل احتواء تلقائى لمدى معين

Sub autofit()
     Range("A1:G1").Columns.autofit
End Sub

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

Sub CopyRange()
     Range("A1").Copy Range("B1")
     Range("A3").Copy Range("c1")
     Range("A5").Copy Range("d2")
End Sub

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

Sub CopyRange1()
     Range("A1:A65536").Copy Range("C1")
End Sub

مرفق ملف به التطبيقات

 

اكواد.rar

[أ/حكيم]

شكرا وبارك الله فيك....

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

كود لانشاء ملف اكسل جديد من داخل الملف الذى تعمل عليه

Sub addone()
 Workbooks.Add
End Sub

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

كود اخر لانشاء ملف اكسيل جديد من داخل الملف الذى تعنمل عليه وحفظه باى اسم تختاره

Sub addnew()
Set newbook = Workbooks.Add
With newbook
.Title = "all seles"
.Subject = "seles"
.SaveAs Filename:="kandeel.xls"
End With
End Sub

[زاكي بوشلاغم]

شكرا  جزيلا  يأخي  ممكن كود  يرتب لقب واسم التلاميذ حسي  الترتيب  الحروف  العربية