نجوم المشاركات

وعليكم السلام ورحمة الله تعالى وبركاته، شكرًا للأخ @Foksh على مشاركته القيمة وبعد إذنه طبعا بالفعل الدالة: =TEXT(L2, "mmm dd, yyyy") مفيدة جدا لإظهار التاريخ بتنسيق واضح لكنها ترجع نصا وليس تاريخا فعليا مما قد يعيق عمليات مثل الترتيب أو الفلترة أو الحسابات المرتبطة بالتواريخ كبديل يعيد قيمة التاريخ الأصلية بدون الوقت وبشكل يمكن Excel التعامل معه كتاريخ حقيقي يمكن استخدام: =INT(L2) أو =QUOTIENT(L2, 1) كلاهما يفصل التاريخ عن الوقت تماما (وتظل قابلة للحسابات مثل التصفية والفرز) ملاحظة: تأكد من تنسيق الخلايا الناتجة كـ [تاريخ] لضمان عرضها بالشكل الصحيح وإذا كنت مهتما أيضا بفصل الوقت بشكل مستقل فيمكن استخدام: =L2 - INT(L2) وهي مفيدة إذا احتجت لاحقا إلى عرض الوقت وحده أو تحليله تحياتي وتقديري للجميع 2 تمديد.xlsx

وعليكم السلام ورحمة الله وبركاته ., أخي الكريم ، تستطيع فعل هذا باستخدام الجملة التالية :- =TEXT(L2, "mmm dd, yyyy") وهذا مرفق لكيفية استخدامها وتنفيذها على جميع الخلايا التي تريدها .. تمديد.xlsx

ياخي الفاضل زر تمت الاجابة على أخر مشاركة لي وليست على ردك الاخير !!!!!!!!!!!!!!!!!

وعليكم السلام ورحمة الله وبركاته اظافة الى اقتراح معلمنا ابوعيد يمكن عن طريق كود قي حدث الورقة قلم 1.xlsb

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

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

ليس المهم لمن افضل اجابة ...المهم انك استفدت وحللت مسألتك وقد يحتاج لها غيرك

اعرض الملف مثال على تصفية فائمة بناء على اخرى بدون كود مثال على تصفية قائمة بناء على ما يتم اختياره فى قائمة اخري بدون كود صاحب الملف محمد طاهر تمت الاضافه 03 أكت, 2011 الاقسام قسم الإكسيل

اتفضل استاذنا الفاضل وجدت هذا البرنامج على النت وهو جميل جدا جدول الحصص الأسبوعي.zip

تفضل اخي تم استبدال الكود ليتناسب مع متطلباتك الحالية مع دمج الاكواد السابقة في نفس الملف Sub CopyData2() Dim x&, OneRng As Range, rCrit As String Dim srcWS As Worksheet, WS As Worksheet Dim i As Long, lrow As Long Set srcWS = Sheets("Data") Set WS = Sheets("FORM3"): rCrit = WS.[G2].Value 'قم بتعديل كود التفقيط بما يناسبك Const iCnt As String = "=IFERROR(@NombreToArabe(E9),"""")" If IsEmpty(WS.[G2].Value) Then: Exit Sub Set OneRng = srcWS.Columns(3).Find(What:=rCrit, LookIn:=xlValues, LookAt:=xlWhole) If OneRng Is Nothing Then MsgBox rCrit & " : " & "غير موجودة", vbInformation: Exit Sub Else Application.ScreenUpdating = False lrow = WS.Cells(WS.Rows.Count, "C").End(xlUp).Row For i = 11 To lrow Union(WS.Range("C" & i), WS.Range("E" & i)).ClearContents Next i x = OneRng.Row WS.[A9] = srcWS.Cells(x, 1) 'الرقم WS.[B9] = srcWS.Cells(x, 2) 'رقم صفحة WS.[C9] = srcWS.Cells(x, 3) 'نوع اللوازم و مواصفاتها WS.[D9] = srcWS.Cells(x, 4) 'رصيد السجل WS.[E9] = srcWS.Cells(x, 33) 'المجموع With WS.[F9] 'العدد كتابة .Formula = [iCnt]: .Value = .Value End With tmp = srcWS.Range("A4:AF" & srcWS.Cells(Rows.Count, 3).End(xlUp).Row).Value2 Dim a(): ReDim a(1 To UBound(tmp) * UBound(tmp, 2), 1 To 5) n = 0 For ligne = 1 To UBound(tmp, 1) For Col = 6 To UBound(tmp, 2) If tmp(ligne, 3) = rCrit And tmp(ligne, Col) <> "" Then n = n + 1 a(n, 2) = tmp(1, Col) 'رؤوس الاعمدة a(n, 4) = tmp(ligne, Col) ' رصيد الغرف المتوفرة End If Next Col Next ligne WS.Cells(k + 11, 2).Resize(n, 3 + 1) = a IRow = WS.Cells(Rows.Count, "E").End(xlUp).Row + 1 WS.[F11] = Application.Sum(WS.Range("E11:E" & IRow)) ' مجموع عمود الرصيد End If Application.ScreenUpdating = True End Sub لقد لاحظت انك لديك القدرة لفهم الاكواد من خلال التعديلات التي قمت بها على الاقتراحات السابقة . حاولت توضيح بعض النقط المهمة على الكود ليسهل عليك التعديل على حسب احتياجاتك مستقبلا. بالتوفيق ..... DATA V4.xlsb

نظرا لأن برنامج اكسل لا يقدم خيار المعاينة على اليوزرفورم أردت أن أقدم فكرة للزملاء الكرام و أعضاء المنتدى الاعزاء الفكرة تعتمد على أخذ صورة للنطاق المراد طباعته على القرص و اعادة تحميلها على مربع الصورة مهم جدا : انشاء مجلد لحفظ الصورة على c باسم raed ثم شغل الملف المرفق C:\raed يمكنك تغيير القرص و اسم المجلد في الكود كما تشاء ثم غير اسم المحلد حسب الكود Private Sub CommandButton1_Click() Const RaedN As String = "C:\raed\officena.jpg" Dim rng As Range Dim shtTemp As Worksheet Dim chtTemp As Chart Application.ScreenUpdating = False Set rng = Worksheets("Sheet1").Range("b2:h11") Set shtTemp = Worksheets.Add Charts.Add ActiveChart.Location Where:=xlLocationAsObject, Name:=shtTemp.Name Set chtTemp = ActiveChart rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture chtTemp.Paste chtTemp.Export Filename:=RaedN Me.Image1.Picture = LoadPicture(RaedN) Application.DisplayAlerts = False shtTemp.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub preview on userform.xlsm

أخي الكريم حماده سعد الله جرب الكود التالي عله يفي بالغرض Sub ExportActiveSheet() Dim WB As Workbook, WS As Worksheet Set WS = ActiveSheet Application.DisplayAlerts = False If WB Is Nothing Then WS.Copy ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value Set WB = ActiveWorkbook If Dir(ThisWorkbook.Path & "\ExportedWB.xlsx") <> "" Then MsgBox "Workbook 'ExportedWB' Is Already Existing", vbCritical WB.Close False Else WB.SaveAs Filename:=ThisWorkbook.Path & "\ExportedWB.xlsx" WB.Close True MsgBox "Workbook Exported In The Same Path ...", 64 End If End If Set WS = Nothing Set WB = Nothing Application.DisplayAlerts = True End Sub تقبل تحياتي

السلام عليكم ورحمة الله كثيرا ما تمنيت اضفاء جماليات على فورم الاكسيل ولكن كنت دائما ما أجد صعوبة في ذلك حتى توصلت لهذة الفكرة وهي تحايل على تلك المشكلة لعلها يكون فيها أفادة او تفتح افاق لأحد الأخوة تقبلوا محاولتي المتواضعة تحياتي New Button.rar

ودا ربع تاتش مني لضيق الوقت عندي المهم تكون الفكرة واضحة بس دا مثال يوضح الثلاث تأثيرات علي الزر aseel.rar

السّلام عليكم و رحمة الله و بركاته أساتذتي الأفاضل : وائل أحمد المصري ياسر العربي ياسر خليل أبو البراء ياسر فتحي البنّا ياسر عبد العزيز البسكري إضافة لما تقدّمتم به من أعمال ثمينة.. بارك الله فيكم جميعًا و زادها بميزان حسناتكم .. و في نفس السّياق .. تفضلّوا ملفا آخرًا به أزرار مضاءة ..للتّنويع و الاستفادة من الموضوع .. فائق إحتراماتي أزرار أمر ملونّة.rar

نسيتوا لمسة جامدة بقي تضاف علي الزرار تعمل كمان image فيها لمعه وتتفعلها بالحدث Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) img3.Visible = True End Sub Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) img3.Visible = False End Sub وادعيلي

طباعة نطاق محدد فقط من ورقة العمل بالطريقة التقليدية يتم من خلال الخطوات التالية: 1- تحديد النطاق المُراد طباعتة. 2- الذهاب إلى القائمة ملف ثم طباعة وفي أسفل مربع حوار الطباعة هناك مربع لتحديد ما نود طباعته .. يحتوي على الثلاث خيارات التالية وهم : - كامل المصنف (طباعة جميع أوراق العمل دفعة واحدة) - ورقة العمل (طباعة ورقة العمل الحالية) - التحديد (طباعة النطاق المحدد) ففي هذه الحالة نقوم بإختيار التحديد والضغط على موافق وعندها سيتم طباعة النطاق الذي قمنا بتحديده مسبقاً. أما إذا أردنا إختصار جميع تلك الخطوات فيكون ذلك عن طريق الكود التالي: Sub SpecialPrint() Sheet2.[A1:D15].PrintOut End Sub مع ملاحظة أن هذا الكود يقوم بطباعة النطاق A1:D15 من الورقة الحالة .. أما إذا أردنا طباعة نطاق معين موجود في ورقة عمل أخرى فنقوم بإضافة إسم ورقة العمل قبل النطاق .. فيكون الكود كالتالي: Sub SpecialPrint2() [F9:H15].PrintOut End Sub شاهد المرفق، _____________________________.rar