طارق_نادر

اشكرك جزيل الشكر اخي الكريم لقد اضئت بنور علمك على مواضيع لم تكن بالحسبان جزاك الله كل خير

اشكرك على مرورك الكريم وانا متابع لحلقاتك القيمة اشكر جهودك المميزة

للرفع رفع الله مقداركم

للرفع رفع الله مقداركم

بكل تأكيد وانا منتظر آراء أساتذتنا الأفاضل

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

اخي الكريم ضع هذا الكود في بداية كود الصفحة المخفية عندك Sheets("اسم الصفحة المخفية حرفيا").Visible = True وفي اخر الكود عندك ضع هذا Sheets("اسم الصفحة المخفية حرفيا").Visible = False

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

تحيا مصر حرة عربية برجالها الاحرار كل الشكر والتقدير تم المطلوب كما تعودنا منك دائما

السلام عليكم اريد عمل تسلسل رقمي للطلاب المرحلين الى ورقة البيانات بحيث يكون الطالب رقم واحد في خلية رقم (b5) والطالب الثاني في خلية رقم (b13) بحيث يكون بين طالب والاخر 7 خلايا لا تحمل رقم متسلسل وهكذا وعدد الطلاب المرحلين غير محدود شاكر تعاونكم

السلام عليكم اريد منكم لطفا ان استفسر عن الثوابت التي لا تتغير في اي كود والمتغيرات التي تختلف بأختلاف المطلوب من الكود وسأرفق كود ارجو التوضيح عليه ماهو الثابت فيه وماهو المتغير اذا تكرمتم فهذه طريقة استاطيع من خلالها ان افهم الاكواد بشكل اعمق Private Sub CmdNew_Click() Dim ws As Worksheet Dim lr As Long Set ws = ThisWorkbook.Sheets("البيانات") If Me.txtid = "" Or Me.txtname = "" Or Me.cbos = "" Or Me.txtplace = "" Or Me.cboy = "" Or Me.txtbdate = "" Then MsgBox "من فضلك قم بإستكمال البيانات الأساسية أولاً قبل الترحيل", vbCritical + vbOKOnly, "حقول فارغة" Exit Sub End If lr = ws.Cells(Rows.Count, "K").End(xlUp).Row + 1 Application.ScreenUpdating = False ws.Range("AB1:AG1").Copy ws.Range("D" & lr + 1).PasteSpecial , Transpose:=True ws.Range("AB2:AH2").Copy ws.Range("F" & lr).PasteSpecial , Transpose:=True ws.Range("AB3:AI3").Copy ws.Range("K" & lr).PasteSpecial , Transpose:=True Application.CutCopyMode = False With ws .Cells(lr, "C") = Me.txtname .Cells(lr, "D") = lbly.Caption .Cells(lr + 1, "E") = Me.txtid .Cells(lr + 2, "E") = Me.cbos .Cells(lr + 3, "E") = Me.txtplace .Cells(lr + 4, "E") = Me.cboy .Cells(lr + 5, "E") = Me.txtbdate .Cells(lr + 6, "E") = Me.lbldate .Cells(lr, "G") = Me.TextBoxA For i = 1 To 6 .Cells(lr + i, "G") = Me.Controls("TextBoxA" & i).Value Next i .Cells(lr, "H") = Me.TextBoxB For i = 1 To 6 .Cells(lr + i, "H") = Me.Controls("TextBoxB" & i).Value Next i .Cells(lr, "I") = Me.TextBoxC For i = 1 To 6 .Cells(lr + i, "I") = Me.Controls("TextBoxC" & i).Value Next i .Cells(lr, "J") = Me.TextBoxD For i = 1 To 5 .Cells(lr + i, "J") = Me.Controls("TextBoxD" & i).Value Next i .Cells(lr, "L") = Me.TextBoxE For i = 1 To 7 .Cells(lr + i, "L") = Me.Controls("TextBoxE" & i).Value Next i End With ws.Cells(lr, 3).Select Application.ScreenUpdating = True End Sub Private Sub CmdPrint_Click() ' Display "Printer Setup" dialog box Application.Dialogs(xlDialogPrinterSetup).Show ' Option Explicit ' Sub SelectSheets() Dim i As Integer Dim TopPos As Integer Dim SheetCount As Integer Dim PrintDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As CheckBox Dim Numcop As Long Application.ScreenUpdating = False ' Check for protected workbook If ActiveWorkbook.ProtectStructure Then MsgBox "Workbook is protected.", vbCritical Exit Sub End If

للرفع

تفضلوا المرفق ارجو الفائدة elebda3.net-391.zip

كل الاحترام

اختي اضغطي على زر المحرر الكامل عند اضافة رد ثم ستنتقلي لصفحة انظري اسفل الصفحة ستجدي خانة لتحميل الملفات ولكن يجب ضغط المرفق اولا

ارجو الفائدة لكم بهذا الكتاب القيم وشرح هذه الدالة الرائعة والخيالية كل التقدير ل أوفيسنا الرائع والزاخر كتاب شرح الدالة إف How To Use Excel IF Function (مدونة فائدة www.faedh.net ).rar

تفضل المرفق جاهز للطباعة ونطاق الطباعة من عمود A الى عمود N ولغاية صف 20 ومحمي ايضا من التعديل بكلمة AHMAD Book1.rar

ارفق الملف وانا بعمل لك المطلوب وكان راح اعمل له حماية من التعديل بس ظروري تحديد النطاق الذي تريد طباعته

او تفضل هذا الكود لطباعة تستطيع تعديل نطاقة كما تحب انا حددت نطاقة كما وضعت في المثال السابق Sub Macro4() ' ' Macro4 Macro ' ' Range("A1:N20").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False End Sub

اخي الكريم ارفق ملف

كل الاحترام والتقدير جزء معلمي الكريم

بعد ابحث وجدت هذه الدورة المفصلة باسلوب سهل للمهتمين ارجو الفائدة لكم http://up.top4top.net/downloadf-top4top_3c73789be01-rar.html

تفضل اخي الكريم المرفق جاهز ولكن عدل فيه لكي يتوافق مع طلبك وهو من انتاجات هذا المنتدى الرائع نموذج معلومات الموظفين 2.rar

اخي الكريم حدد اسم العمود او النطاق او الخلايا المراد مسح محتوياتها

كل الشكر والتقدير تم المطلوب كما اردت واكثر كما تعودت منك اشكر جهودك المباركة