قنديل الصياد

مواقع اخرى لاكواد الاكسل http://www.ozgrid.com/VBA/MiscVBA.htm http://www.cpearson.com/excel/excelm.htm http://www.anthony-vba.kefra.com/ http://www.excel-vba-easy.com

أخي العزيز الأستاذ / مصطفى كامل بارك الله فيك و أثابك خيرا الأخ الحبيب الأستاذ / حمادة عمر شكرا لك و نفعنا الله بعلمك جزاك الله خيرا ولاثراء الموضوع اليكم هذه الموقع الرائعة ايضا http://www.functionx.com/vbaexcel/ http://www.contextures.com/xlfaqMac.html#NoMacros واليكم بعض الاكواد ومرفق ملفات للتطبيق عليها من الموقع الذى اتحفنا به اخينا وحبيبنا الاستاذ / مصطفى كامل وهى موجودة ايضا على رابط اكواد اعجبتنى بمنتدانا الجميل http://www.officena.net/ib/index.php?showtopic=48249 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 Sub FormatCell() ' Dim myVar As Range Set myVar = Selection With myVar .NumberFormat = "#,##0.00_);[Red](#,##0.00)" .Columns.AutoFit End With End Sub 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 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 Book1.rar اكواد.rar اكواد1.rar عتت.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 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 FormatCell() ' Dim myVar As Range Set myVar = Selection With myVar .NumberFormat = "#,##0.00_);[Red](#,##0.00)" .Columns.AutoFit End With 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

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

اخى العزيز اليك ما طلبت المعادلة المستخدمة =IF(A3>=18;"ممتاز";IF(A3>=16;"جيد جدا";IF(A3>=14;"جيد";IF(A3>=11;"حسن";IF(A3>=10;"متوسط";IF(A3>=6;"دون المتوسط";"ضعيف")))))) مرفق ملف به التطبيق Book1.rar

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

اخى العزيز قمت بعمل مجموعة صور وصلبت الى 280 صورة وقمت بعمل ارتباط تشعبى لبعض الصور وقمت بعمل نسخة اخرى من نفس الورقة وتم عمل نسخة من الورقة بكامل محتوياتها بكل الصور وبكل تنسيقاتها بدون فقد اى تنسيق على الصور وبنفس طريقة الشرح السابقة يمكن ان تكون المشكلة فى نسخة الويندز او الاوفيس عند حضرتك كل عام وحضرتك بخير مرفق ملف به مجموعة الصور Book1.rar

وجزاك الله اخى وعزيزى الاستاذ / على حسن خير الجزاء وكل عام وحضرتك بخير

اخى العزيز تم اضافة امر للطباعة على الفورم منظومة موظفين الموااصلات.rar

وهذا ملف اخر به مجموعة صور وتم عمل ورقة اخرى بنفس الطريقة وبنفس الصور صور.rar

اخى العزيز اليك الشرح كالتالى : عندى ورقة اسمها البيانات وقمت بتنسيقها وادراج بعض البيانات بها واريد نسخة طبق الاصل منها بنفس التنسيقات والبيانات ساقوم بعمل الاتى كما بالصورة التالية : ثم اتبع الصورة التالية وقم بتحديد المربع امام كلمة انشاء نسخة كما بالصورة التالية ثم اضغط على كلمة نقل الى النهاية او حدد المكان كما تريد ستجد ان ورقة البيانات تم نسخها بنفس الموجود بالورقة الاولى مرفق ملف به التطبيق Book1.rar

شكرا اخى واستاذى الكريم / ابو آلاء وان شاء الله ساقوم برفع كل الملفات على رابط واحد كل عام وحضرتك بخير

أوامر الخط والمحاذاة

أوامر الخلايا

أظهار اخفاء أشرطة الادوات فى اكسل

كيفية اخفاء واظهار الاعمدة والصفوف فى برنامج اكسل http://www.youtube.com/watch?v=_dVRu3ZoWao

حماية البيانات في الاكسل 3-3

حماية البيانات في الاكسل 2-3

حماية البيانات في الاكسل 1-3

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