الجموعي

السلام عليكم ورحمة الله تعالى وبركاته بعد الإصدار الذي طرحته قبل أيا والذي تحت عنوان هدية لمحبي الألوان والتصميم فورم لمعرفة رموز الالوان أقدم لكم الإصدار جديد من فورم RGB Color Codes Chart واجهة الفورم نأتي الأن لشرح الفورم 1) نقوم بإنشاء 3 ============ ScrollBar نسميها كالتالي: RGB_Red RGB_Green RGB_Blue خصائصها موضحة في الصورة التالية أنا إخترت RGB_Red وهكذا مع بقية ScrollBar 2) نقوم بإنشاء 3 =========== TextBox نسميها على النحو التالي TRed TGreen TBlue خصائصها موضحة في الصورة التالية أنا إخترت TRed وهكذا مع بقية TextBox 3) نقوم بإنشاء ========== Label نسميه بإسم RGB_Color خصائصه موضحة في الصورة التالية 4) نقوم بإنشاء ========== CommandButton نسميها بإسم Cmd_Copy خصائصه موضحة في الصورة التالية نأتي إلى المرحلة المهمة وهي إدراج الاكواد 1) في حدث ScrollBar مثال: أنا أخترت ScrollBar الأحمر وهكذا مع باقي ScrollBar Private Sub RGB_Red_Change() RGB_Color.BackColor = RGB(TRed, TGreen, TBlue) 'والقيم تأخذ من مربعات النص الثلاث RGBالليبل المسمى(RGB_Color) عند تعبئة بالون يساوي Me.TRed = RGB_Red ' هنا قيمة مربع النص تساوي قيمةScrollBar End Sub 2) في حدث TextBox مثال: أنا أخترت TextBox الأحمر وهكذا مع باقي TextBox Private Sub TRed_Change() RGB_Red = Me.TRed ' هنا قيمة( ScrollBar) تساوي قيمة مربع النص End Sub 3) في حدث CommandButton زر النسخ Cmd_Copy نستعمل الكود التالي Private Sub Cmd_Copy_Click() Dim myClipbd As New DataObject With myClipbd .SetText "RGB" & " " & "(" & Me.TRed & "," & " " & Me.TGreen & "," & " " & Me.TBlue & ")" .PutInClipboard End With MsgBox "تم النسخ بنجاح" End Sub عند لصق الكود يكون على الشكل التالي RGB (150, 103, 53) أتمنى الشرح والفكرة نالت إعجابكم تم بحمد الله وتوفيقه أترككم مع الملف المرفق RGB Color New.rar

تفضل اخي الكريم ما طلبته كل ورقة لها كلمة سر خاصة بها مساعدة 1.rar

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

تفضل اخي ما طلب بقيت مشكلة واحدة وهي عند إدخال كلمة مرور خاطئة لا تظهر الرسالة للعلم الرسالة مكتوبة في الكود لاني او قفتها في إنتظار احد الاساتذة يقوم بتعديل على الكود لتتم العملية مساعدة 1.rar

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

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

فعلا نجحت العمليه بهذا الكود لكن في حالة إذا كانت الورك بوك مفتوحة عندما أضفت هذه الاكواد في حدث الوررك بوك Private Sub Workbook_Open() Workbooks.Application.ShowStartupDialog = False Workbooks.Application.DisplayAlerts = False ActiveWorkbook.Application.Visible = False UserForm1.Show End Sub عند الضغط على زر حفظ وخروج يغلق الملف لكن يبقى يعمل في الخلفية أقوم بإغلاقه عن طريق إدارة المهام وبالنسبة لإخفاء الورك بوك اريده أيضا ان يخفي فقط وورك بوك معين ليس كل الوورك بوك المفتوحة زر خروج.rar

أستاذي الكريم قمت بتجربة الكود ولم يفلح ظهرت هذه الرسالة

السلام عليكم أستاذي /ياسر كود إنشاء صفحة ومعرفة إن كانت مكررة أم لا المتطلبات: يوزر فورم مربع نص نسمية SheetNewName زر تحكم نسمية Cmd_NewSheet Private Sub Cmd_NewSheet_Click() Dim i As Integer ' إعلان متغير i عدد صحيح For i = 1 To Worksheets.Count 'متغير i تساوي من ورقة العمل 1 إلى اخر أوراق العمل ' تفحص ما اذا كان اسم ورقة موجود أم لا If SheetNewName.Text = Worksheets(i).Name Then ' إذا كانت القيمة في مربع النص تساوي إسم ورقة من أوراق العمل MsgBox "إسم الصفحة موجود مسبقا, يرجى إختيار إسم أخر", vbOKOnly + vbCritical, "تنبيه" Exit Sub ' إنهاء الإجراء End If 'إنهاءالشرط Next ' التالي 'إنشاء ورقة عمل جديدة بعد أخر ورقه عمل موجودة Sheets.Add After:=Sheets(Sheets.Count) 'تسمية ورقة العمل الجديدة بإسم القيمة المدرجة في مربع النص Sheets(Sheets.Count).Name = SheetNewName.Text 'تصفير البيانات في مربع النص SheetNewName.Value = "" End Sub

السلام عليكم ورحمة الله تعالى وبركاته أريد منكم مساعدة في تعديل هذا الكود بحيث عن الخروج من ملف معين لا يتم إغلاق باقي الملفات مثال عندي ملف بإسم اوفيسنا1 وملف أخر بإسم أوفيسنا 2 عن الضغط على زر خروج يقوم بالخروج من الملفين وأنا أريد الخروج من ملف واحد فقط Private Sub Cmd_Close_Click() ActiveWorkbook.Save Workbooks.Application.Quit End Sub

تفضل ما طلبته فورم ادخال و تعديل مرن مع الطباعة.rar

وبالنسبة لكود الحماية على مستوى البيانات المدخلة في حدث زر إدخال سجل جديد قم بوضع هذا الكود عند الضغط على زر إدخال سجل جديد تظهر رسالة تطالبك بكلمة المرور وهي 123 Private Sub ButtonNew_Click() Dim PASS As String: PASS = "123" If Application.InputBox("قم بكتابة كلمة المرور حيتى يتسنى لك إضافة السجل الجديد") <> PASS Then MsgBox ("كلمة مرور غير صحيحة") Else MsgBox ("كلمة مرور صحيحة .. تفضل البيانات") kh_AddNewRecord End If End Sub في حدث زر حذف سجل الحالي قم بوضع هذا الكود عند الضغط على زرحذف سجل الحالي تظهر رسالة تطالبك بكلمة المرور وهي 1234 Private Sub ButtonDelete_Click() Dim PASS As String: PASS = "1234" If Application.InputBox("قم بكتابة كلمة المرور حيتى يتسنى لك إضافة السجل الجديد") <> PASS Then MsgBox ("كلمة مرور غير صحيحة") Else MsgBox ("كلمة مرور صحيحة .. تفضل البيانات") If MsgBox(" هل تريد حذف السجل رقم : " & iRow & vbCr & vbCr & String$(40, "="), vbCritical + vbYesNo + mBox + vbDefaultButton2, "تاكيد الحذف ") = vbNo Then Exit Sub If Me.ListFind.ListCount Then Me.ListFind.Clear MyRngdate.Rows(iRow + 1).EntireRow.Delete If Not tSr Then GoTo 1 If iRow = ContRow Then GoTo 1 With MyRngSeri .Cells(iRow + 1, 1).Value = iRow Range(.Cells(iRow + 1, 1), .Cells(ContRow, 1)).DataSeries End With 1: Me.ScrollBar1.Max = ContRow - 1 ScrollBar1_Change Call MsgBox(" تم حذف السجل بنجاح ", mBox, "الحمدلله") End If End Sub أما إذا اردت كلمة المرور بنطاق في ورقة العمل قم بتعديل اول سطر Dim PASS As String: PASS = Range("A1")

السلام عليكم بالنسبى لحماية البيانات المدخلة في الشيت من التعديل أو الحذف تفضل كود فك الحماية: 123 فورم ادخال و تعديل مرن مع الطباعة 3ffffffff.rar

تفضل أخي: كود مميز لتعبئة اليست بوكس أو الكمبو بكس من عمود بدون تكرار من مشاركة الأستاذ القدير شوقي ربيع في: المشروع الكبير (مكتبة الصرح .. زاخرة بالشرح) وهي عبارة عن تجميع لمكتبة الأكواد http://www.officena.net/ib/index.php?showtopic=57935&p=370430

ماشاء الله عندي إستفسار أستاذي في مرفقك الحل الأول في خلية ظهور التفقيط بالكتابة أدرجت هذه المعادله لماذا؟ =TRIM(Monitize(F7)) كان بإمكانك ترك المعادلة السابقة =Monitize(F7)

محاولة بسيطه مني =Monitize(E7&"."&D7) في الخلية E7 تكتب الدينار في الخلية D7 تكتب الفلس

أخي الكريم الجموعي، هذا حل باستعمال المعادلات... أخوك بن علية الملف المرفق : حل ترجمة بالمعادلات.rar ماشاء الله فعلا حل قريب لما طرحته انا في المرفق في إنتظار حلول الأستاذة الأفاضل لإثراء الموضوع وتنوع الحلول

لغز دسم بأي الأكواد او المعادلات يتم عمل مثل العمل في المرفق ترجمة.rar

أخي الكريم جرب الكود التالي Sub RefreshAll() ThisWorkbook.RefreshAll End Sub

تفضل أخي لعله المطلوب حذف خلية من الكمبو بكس.rar

اللهم أمين الأروع مرورك أستاذي إبن مصر ربي يحفظك

السلام عليكم ورحمة الله تعالى وبركاته كود رائع لتنسيق خصائص الكمبوبوكس وتعبئته بمدى ديناميكي من عمود قابل للزيادة أو النقصان Private Sub UserForm_Initialize() ' متغير خاص ببايانات الكمبوبوكس Dim J As Long 'متغير خاص بأوراق العمل Dim ws As Worksheet ' تحديد ورقة العمل المراد إستدعاء البيانات Set ws = Sheets(1) 'خصائص الكمبوبوكس With Me.ComboBox1 ' خاص بظهور الأعمدة في الكمبوبوكس .ColumnCount = 1 ' عدد الصفوف التي المراد إظهارها .ListRows = 12 'خاص بتنسيق النص(محاذاة لليمين , توسيط , محاذاة لليسار) .TextAlign = fmTextAlignCenter 'تنسيق خصائص الخط في الكمبوبوكس With .Font 'إسم الخط .Name = "Times New Roman" 'حجم الخط .Size = 12 'تغميق الخط .Bold = True End With 'إلى غاية أخر العمود A يساوي الصف الثاني من العمود j متغير For J = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row 'بداية من الصف الثاني إلى غاية أخر بيانات في العمود A كتابة بيانات الموجودةفي العمود .AddItem ws.Range("A" & J) Next J End With End Sub

بارك الله فيك أستاذي والله أتحفتنا به هذه الأكواد الرائعة ActiveSheet.Unprotect ([j1]) Rows("6:5001").Select Selection.EntireRow.Hidden = True ActiveSheet.Protect ([j1]) انت وضعته في حدث فتح الورك بوك لحماية الشيت وإخفاء المحددة ولماذا وضعته ايضا في زر البحث وضعته ايضا في الموديول 4 Sub hide()

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

تم التعديل وإضافة نسخ طريقة النسخ بعدإختيار من مجموعة الألوان نذهب الى مربع المعاينة الكبير دبل كليك تظهر لك رسالة تم النسخ بنجاح عند اللصق الكود يظهر على النحو التالي: Hex: # FF3333 RGB (255, 51, 51) الرجاء من المشرفين على هذا القسم دمج هذه المشاركة مع المشاركة الأولى RGB color.rar