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

@ابا جودى ماشاء الله عليك استاذ فعلا اذا تسمحوا لتلميذ من تلاميذكم بالمشاركة وبعد الاذن من استاذنا الفاضل @عبد الله قدور ولكن عن طريق for next تنازلي.accdb

وعليكم السلام اتفضل استاذ @عبد الله قدور Dim i As Integer i = 6 Do While i < 10 i = i - 1 If i = 1 Then Exit Do MsgBox "The value of i is : " & i Loop طبعا غير انت ما يلزمك حسب قاعدتك انا اعطيتك الفكرة بشكل عام

فورم لترحيل اى عدد معين من البيانات الى صفحة الترحيلات الفيديو الصورة

تفضل لك ما طلبت تنسيق شرطى بشرطين.xlsx

وعليكم السلام-تفضل لك ما طلبت جمع نطاق من ورقه إلى أخرى.xlsx

بعد اذن اخي حسين هذا الكود Option Explicit Sub copy_Form_to() Dim M As Worksheet: Set M = Sheets("Main") Dim L As Worksheet: Set L = Sheets("list") If Not IsNumeric(L.Range("g5")) Or L.Range("g5") = 0 Then Exit Sub If Not IsNumeric(L.Range("I5")) Or L.Range("I5") = 0 Then Exit Sub Dim lrM%: lrM = M.Cells(Rows.Count, 3).End(3).Row Dim RgC As Range: Set RgC = L.Range("C6:C35") L.Range("b5").CurrentRegion.Offset(1).ClearContents Dim My_Min: My_Min = Application.Min(L.Range("g5:I5")) Dim My_Max: My_Max = Application.Max(L.Range("g5:I5")) If My_Max > lrM - 2 Then My_Max = lrM - 2 Dim t%, K% Dim r%, c%, X% r = 6: c = 3 My_Min = Int(Abs(My_Min)): My_Max = Int(Abs(My_Max)) For t = My_Min To My_Max On Error Resume Next X = M.Range("c:c").Find(t, lookat:=1).Row If Err.Number Then Err.Number = 0: GoTo next_t If X Then K = K + 1 If K = (RgC.Rows.Count) * 2 + 1 Then Exit For L.Cells(r, c - 1) = t: L.Cells(r, c) = M.Cells(X, 4) r = r + 1 If K = RgC.Rows.Count Then r = 6: c = c + 2 End If next_t: Next End Sub الملف مرفق aaaa.xlsm

فورم ترتيب الاسماء تصاعدى وتنازلى بزر ToggleButton الفيديو الصورة

السلام عليكم و رحمة الله تعالى و بركاته الأستاذ عبد الله طلب طريقة استعمال الحلقات التكرارية بالعد التنازلي و هذا يعني استعمالها بدون دوال إضافية مثل الدوال الشرطية للحلقات التكرارية ستة أشكال و قد شرحتها جميعها في هذه السلسلة: دروس VBA أكسس و هذا حل لسؤال الأخ عبد الله بخمسة أشكال من الحلقات التكرارية: الأول: الدالة For Dim i As Integer, k As Integer k = 4 For i = k To 1 Step -1 MsgBox i Next i الثاني: الدالة Do While Dim i As Integer i = 4 Do While i >= 1 MsgBox i i = i - 1 Loop الثالث: الدالة Do Until Dim i As Integer i = 4 Do Until i < 1 MsgBox i i = i - 1 Loop الرابع: الدالة Do.....Loop Until Dim i As Integer i = 4 Do MsgBox i i = i - 1 Loop Until i < 1 الخامس: الدالة Do.....Loop While Dim i As Integer i = 4 Do MsgBox i i = i - 1 Loop While i >= 1

1- تنازلي.accdb

اعتذر للتأخير فى الرد عليكم العفو منكم استاذى الكريم واخى الحبيب الاستاذ @kha9009lid انا اقل طالب علم فى المنتدى طيب ان اردت الافكار جميعا والتى تدور بخلدى حول هذه النقطه ووفقا لمثالكم الاطثر من رائع الفكرة الأولى من خلال SELECT CASE , DO WHILE Select Case Nz(Me.الكمية, "") Case "" Me![الكمية].SetFocus MsgBox "حقل الكمية مطلوب" Exit Sub Case Is <= 0 Me![الكمية].SetFocus MsgBox "لا يمكن معالجة هذه الكمية" Exit Sub Case Is > 0 Dim i As Integer i = [الكمية] + 1 Do While i = i i = i - 1 If i = 0 Then Exit Do Me.رقم = i Me.الموقع = i Me.المدينة = "القاهرة" DoCmd.GoToRecord , , acNext Loop End Select الفكرة الثانية If IsNull([الكمية]) Then MsgBox "حقل الكمية مطلوب" Me.الكمية.SetFocus Exit Sub Else Dim i As Integer i = [الكمية] + 1 Do While i = i i = i - 1 If i = 0 Then Exit Do Me.رقم = i Me.الموقع = i Me.المدينة = "القاهرة" DoCmd.GoToRecord , , acNext Loop End If

تفضل هذا التعديل Overtime2019.accdb

الف الف سلامة عليك يا خالي اجر و عافية و طهور انشاء الله أسأل الله العظيم رب العرش العظيم أن يشفيك أسأل الله العظيم رب العرش العظيم أن يشفيك أسأل الله العظيم رب العرش العظيم أن يشفيك

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

جزاك الله كل خير ونفع الله بكم وأمد في عمركم بالخير والبركة والطاعة المقبولة بإذن الله تعالى

في كل الأحوال ما يدور في رأسي هو سحب عدة صورة و من ثم تحويل الصور الى ملف PDF بالكود و هذا اسهل الحلول تقريبا

نعم اخي الكريم فهذا الاستعلام ماهو الا الحاق للبيانات و ليس له دخل في التصميم نهائيا

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

بارك الله فيك وجزاك الله خير الثواب

استكمالا للملف السابق اعلاه ، و الذي يعطي التوقيتات فى مختلف الدول احتجت اليوم لمعرفة مجال معين من الساعات فى عدة بلدان مختلفة لاختيار وقت يلائم اشخاص مختلفين متواجدين فى تلك الدول و عليه اعددت الملف البسيط المرفق و احببت مشاركته لعله يفيد من يحتاج مثل ذلك الملف فقط يعتمد على الدالة time لاضافة عدد الساعات ، و لاستخدامه يتم فيه تسجيل مجال العمل بالساعة فى الدولة الاولي ثم قيمة الاختلاف عن توقيت جرينتش افقيا للثلاث دول الاخرى ( الخلايا باللون الاصفر) GMT-converster.xlsx

بعد إذن الأستاذ / أحمد يوسف جرب هذا BOOK2.xlsx

بارك الله فيك وزادك الله من فضله

السلام عليكم أولا: لقد قمت بتغيير عنوان المشاركة لكي تتناسب مع المضمون ثانيا: لقد قمت بإنشاء نموذج اسمه frm_icon به الصورة التي تريدها كل ما عليك هو فتح التقرير و سحب هذا النموذج غلى داخل التقرير و هذا مثالك بعد التعديل ook.rar

بحيث يتم التلوين اذا كان بداية من الخلية C7 لا يساوى فراغ ,بحيث اذا كانت بداية من الخلية C7 = فراغ أى "" لا يتم التلوين فشرط التلوين ان تكون الخلية بها بيانات فاذا لم تكن هذه الجزئية موجودة بالمعادلة فسيتم تلوين الخلايا الفارغة ايضا

وعليكم السلام-الأمر بسيط تم ذلك بالتنسقات الشرطية وهذه هى المعادلة المستخدمة لذلك واعتقد ان افضل طريقة للشرح بالصور =AND($D7<=TODAY(),$C7<>"")

لا شكر على واجب كلنا اخوان هون تحياتي اخي

السلام عليكم برنامج جاهز من المنتدى لم ارى افضل منه حيث يقوم بعمل :- جدول كل فصل او كل الفصول جدول كل مادة او كل المواد جدول كل مدرس او كل المدرسين الجدول الكلي ادعو الله ان يكون حسنات مضاعفة في ميزان صاحب البرنامج العلامة عبدالله باقشير https://www.officena.net/ib/topic/30490-برنامج-الجداول-المدرسية/

ممتاز جدا بارك الله فيك وفي جهدك ممنون لك كثير رح اجرب غدا بحول الله ادخال بيانات بالعمل واوافيك بالنتيجة ان شاء الله

قطعا انا احب التعامل قدر الأمكان مع select case بدلا من if طبعا انا بالرد الاول اجبت بـ DO WHILE لانه كان محور التساؤل اصلا ولكن اثراء للموضوع اضفت كل الافكار التى دارت بخلدى حول هذا الموضوع طبعا من بعدكم استاذى الحبيب

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

تفضل جرب هذا اخي الكريم السبب ان اصدار الاوفيس لديك قديم لكن جرب المرفق و اعطيني النتائج مثال للتعامل مع الصور.mdb

ارهقني جدا التعامل مع الأكسس بسبب انه يفتقر للمكتبات سؤال اخي الكريم ... ماذا لو تمكنا من اضافة مكتبة ادوات iTextSharp فأنا استخدم هذه المكتبة مع لغة VB.ASP/#C/VB.NET انظر الى هذا المثال لهذه المكتبة و الذي من خلاله قمنا بإنشاء ملف PDF من خلال الكود و وضعنا به جميع البيانات و الصور كذلك سهولة توصيل الماسح الضوئي و الكاميرا سواء للهاتف المحمول او اللابتوب او اي كميرا خارجية Try Dim d As New Document(PageSize.A4, 20.0F, 0.0F, 0.0F, 0.0F) PdfWriter.GetInstance(d, New FileStream(MapPath("~/Files/محضر اثبات حالة.pdf"), FileMode.Create)) Dim bflatha As BaseFont = BaseFont.CreateFont(MapPath("~/timesbd.ttf"), BaseFont.IDENTITY_H, False) Dim Font As Font = New Font(bflatha, 14) d.Open() Dim image1 = iTextSharp.text.Image.GetInstance(MapPath("~/22.png")) image1.ScaleAbsolute(600.0F, 120.0F) d.Add(image1) Dim image2 = iTextSharp.text.Image.GetInstance(MapPath("~/11.png")) image2.ScaleAbsolute(220.0F, 100.0F) d.Add(image2) Dim image3 = iTextSharp.text.Image.GetInstance(MapPath("~/3.png")) image3.ScaleAbsolute(600.0F, 30.0F) d.Add(image3) Dim ph1 As Paragraph = New Paragraph("" & vbNewLine & TextBox3.Text, Font) Dim table1 As PdfPTable = New PdfPTable(1) table1.RunDirection = Element.ALIGN_JUSTIFIED Dim cell1 As PdfPCell cell1 = New PdfPCell(ph1) cell1.RunDirection = PdfWriter.RUN_DIRECTION_RTL cell1.HorizontalAlignment = Element.ALIGN_JUSTIFIED d.Add(table1) cell1.Border = 0 table1.AddCell(cell1) d.Add(table1) Dim ph2 As Paragraph = New Paragraph("" & vbNewLine & TextBox4.Text, Font) Dim table2 As PdfPTable = New PdfPTable(1) table2.RunDirection = Element.ALIGN_CENTER Dim cell2 As PdfPCell cell2 = New PdfPCell(ph2) cell2.RunDirection = PdfWriter.RUN_DIRECTION_RTL cell2.HorizontalAlignment = Element.ALIGN_CENTER d.Add(table2) cell2.Border = 0 table2.AddCell(cell2) d.Add(table2) Dim ph As Paragraph = New Paragraph("" & vbNewLine & t3.Text, Font) Dim table As PdfPTable = New PdfPTable(1) table.RunDirection = Element.ALIGN_JUSTIFIED Dim cell As PdfPCell cell = New PdfPCell(ph) cell.RunDirection = PdfWriter.RUN_DIRECTION_RTL cell.HorizontalAlignment = Element.ALIGN_JUSTIFIED d.Add(table) cell.Border = 0 table.AddCell(cell) d.Add(table) Dim ph8 As Paragraph = New Paragraph("" & vbNewLine & TextBox5.Text, Font) Dim table8 As PdfPTable = New PdfPTable(1) table8.RunDirection = Element.ALIGN_CENTER Dim cell8 As PdfPCell cell8 = New PdfPCell(ph8) cell8.RunDirection = PdfWriter.RUN_DIRECTION_RTL cell8.HorizontalAlignment = Element.ALIGN_CENTER d.Add(table8) cell8.Border = 0 table8.AddCell(cell8) d.Add(table8) Dim ph11 As Paragraph = New Paragraph(job.Text, Font) Dim table11 As PdfPTable = New PdfPTable(1) Dim cell11 As PdfPCell cell11 = New PdfPCell(ph11) cell11.RunDirection = PdfWriter.RUN_DIRECTION_RTL cell11.HorizontalAlignment = Element.ALIGN_RIGHT d.Add(table11) cell11.Border = 0 table11.AddCell(cell11) d.Add(table11) Dim image44 = iTextSharp.text.Image.GetInstance(MapPath("~/stamp/" & seig.Text.Trim)) image44.ScaleAbsolute(100.0F, 50.0F) image44.Alignment = Element.ALIGN_LEFT Dim table42 As PdfPTable = New PdfPTable(1) Dim cell42 As PdfPCell cell42 = New PdfPCell(image44) cell42.RunDirection = PdfWriter.RUN_DIRECTION_RTL cell42.HorizontalAlignment = Element.ALIGN_RIGHT d.Add(table42) cell42.Border = 0 table42.AddCell(cell42) d.Add(table42) Dim ph4 As Paragraph = New Paragraph(usernamem.Text, Font) Dim table4 As PdfPTable = New PdfPTable(1) table4.RunDirection = BorderStyle.None Dim cell4 As PdfPCell cell4 = New PdfPCell(ph4) cell4.Border = 0 cell4.RunDirection = PdfWriter.RUN_DIRECTION_RTL cell4.HorizontalAlignment = Element.ALIGN_RIGHT d.Add(table4) cell1.Border = 0 table4.AddCell(cell4) d.Add(table4) Dim image5 = iTextSharp.text.Image.GetInstance(MapPath("~/stamp/" & stamp.Text.Trim)) image5.ScaleAbsolute(100.0F, 50.0F) image5.Alignment = Element.ALIGN_LEFT Dim table3 As PdfPTable = New PdfPTable(1) Dim cell3 As PdfPCell cell3 = New PdfPCell(image5) cell3.RunDirection = PdfWriter.RUN_DIRECTION_RTL cell3.HorizontalAlignment = Element.ALIGN_RIGHT d.Add(table3) cell3.Border = 0 table3.AddCell(cell3) d.Add(table3) d.Close() Response.Clear() Response.ContentType = "application/octet-stream" Response.AddHeader("Content-Disposition", "attachment; filename=""downloadName.pdf""") Response.WriteFile(Server.MapPath("~/Files/محضر اثبات حالة.pdf")) Response.End() Catch ex As Exception Label1.Text = ex.Message.ToString End Try

تفضل التعديل اخي الكريم test (1).rar

تفضل اخي الكريم If [ActiveXCtl0].Visible = False Then [ActiveXCtl0].Visible = True Else [ActiveXCtl0].Visible = False End If

تفضل محمد.xls

بعد اذن الأستاذ أحمد-هذا حل اخر لإثراء الموضوع بدون أعمدة مساعدة serial Number.xlsx

بارك الله تعالى فيك في ميزان حسناتك بإذن الله تعالى

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

علا الله من قدرك ورفع من شئنك هذا هو المطلوب بضبط وشكرا كثير

إسم الملف: محول التوقيت أضيف للمكتبة بواسطة: محمد طاهر تاريخ الإضافة: 21 Sep 2011 آخر تحديث: 22 Sep 2011 القسم فى المكتبة: قسم الإكسيل السلام عليكم و رحمة الله و بركاته هذا الملف قمت باعداده ليوفر لي الوصول للتوقيت فى مختلف الدول سريعا ، فضلا عن معرفة التاريخ و التوقت المحلي لتوقيت و تاريخ مناظر فى دولة أخري ، مثلا لمعرفة التوقيت المحلي لمحاضرة على النت أو مؤتمر. بالطبع هناك مواقع و تطبيقات عديدة تقوم بذلك و لكن اردته فى ملف اكسيل للسهولة و الملف لا يحوي أكواد و يشامل على استخدام للدالة time و لا يعتبر تطبيق متقدم ، وهو مجرد تطبيق عادى فى الاكسيل، الملف اعددته على عجل ، و فى اتتظار الابداعات و الاضافات و التحسينات كالمعتاد أدخل التوقيت المحلي لديك فى الخلية البرتقالية اللون G1 مثلا فى مصر ندخل 2 لان التوقيت GMT+2 يظهر لك مباشرة فى النصف الايمن التوقيت فى مختلف الدول بحسب الفرق عن جرينتش ، و طبعا لم يتم ذكر الدول و لا المدن كلها و انما العبرة بالفرق عن جرينتش و مصدر قائمة الدول من احد مواقع تحويل الوقت الاجنبية لذا لا يحوي كل المدن و الدول و يمكننا تعديله لاحقا الجزء الثاني من الملف يتيح لك معرفة الوقت المحلى لتاريخ ووقت مناظر فى مكان آخر فنقوم بادخال التاريخ و الوقت فى الخلية المناظرة للدولة فى العمود c باللون البرتقالي ، مع الحفاظ على التنسيق ، فنحصل على التوقيت المحلى فى العمود d لنفس السطر إضغط هنـــــــــــا لتنزيل الملف

تفضل أخي المثال بعد تعديل Database1 (1).accdb

أعجبتني فكرة الرجستري جرب هذا التعديل: za-font style and align-LAST.rar

هذه محاولة ان لم يعجبك انتظر احد الاساتدة ليجيبك Option Explicit Sub copy_list() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lr, x, r Dim rng1 Dim rng2 Application.ScreenUpdating = False Set ws1 = Sheets("main") Set ws2 = Sheets("list") With ws2 .Range("b6:c10000").ClearContents Set rng1 = .Range("g5") Set rng2 = .Range("i5") If rng1 = "" Or rng2 = "" Then Exit Sub r = 6 lr = ws1.Cells(Rows.Count, "c").End(xlUp).Row For x = 3 To lr Select Case ws1.Cells(x, "c").Value2: Case rng1 To rng2 .Range("b" & r).Resize(1, 2).Value = ws1.Cells(x, "c").Resize(1, 2).Value r = r + 1 End Select Next x End With Application.ScreenUpdating = True End Sub aaaa.xlsm

تفضل هذا التعديل اخي الكريم Overtime2019.accdb

تفضل التعديل اخي الكريم اختيار المربع و ادخال ارقام .accdb

جرب هذا za-font style and align-LAST.mdb

تفضل Clear.xlsm

اهلا بك اخى الكريم بالمنتدى كان عليك من البداية استخدام خاصية البحث فى المنتدى لتجد ما يناسبك تفضل https://www.officena.net/ib/topic/85366-مساعده-بخصوص-جدول-مواعيد-اجازات-الموظفين/?tab=comments#comment-541418 https://www.officena.net/ib/topic/83102-برنامج-اجازات-الموظفين/?tab=comments#comment-528759

وعليكم السلام تفضل Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function EmptyClipboard Lib "user32" () As Long Public Declare Function CloseClipboard Lib "user32" () As Long Public Sub ClearClipboard() OpenClipboard (0&) EmptyClipboard CloseClipboard End Sub

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

مستند الوورد يتكون من صفحات وهذا أمر طبيعي كما تعلم وعادة نستخدم إعداد هامش واحد لكل المستند ( وللعلم فإن إعداد الهامش يسري على كامل المستند) وفي مثل هذه الحالة لا نحتاج إلى استخدام إي تغيير في المستند، ولكن إذا أردنا أن نجعل لأحد الصفحات هامشا يختلف عن بقية الصفحات أو أردنا أن نجعل اتجاه الصفحة أفقيا بينما اتجاه باقي المستند عمودي فهناك طريقة واحدة وهي باستخدام المقطع وللتسهيل فإن كل مقطع يعتبر وكأنه مستند منفصل يعني يمكن تغيير حجم الهامش أو اتجاه الصفحة للمقطع وحده دون باقي المستند. المقطع ليس له حجم محدد فقد يكون جزء من صفحة أو مئة ورقة وفي الصورة المرفقة ستجد 3 مقاطع في نفس الصفحة كل منها لها إعداد مختلف للهامش وأتمنى أن تكون المسألة واضحة الآن ويمكن معرفة مكان المقاطع باستخدام زر اظهار العلامات المخفية ( يشبه حرف P مقلوب )