نجوم المشاركات
Popular Content
Showing content with the highest reputation on 16 ديس, 2024 in all areas
-
استاذنا ومعلمنا الاستاذ/موسى تمام هو المطلوب جزاك الله خير وجعله فى ميزان الحسنات وبارك الله فى اعمالك الجميلة التى عن نفسى تطربنى وتشجينى1 point
-
وعليكم السلام ورحمة الله تعالى وبركاته ادا كان هدا ما تقصده جرب هدا =IFERROR(TEXT(DATE(2000+LEFT(B2,2),MID(B2,3,2),RIGHT(B2,2)),"DD/MM/YYYY"),"") او Option Explicit Sub ConvertDate() Dim lr As Long, r As Long, xDate As String, n As String Dim scWS As Worksheet: Set scWS = Sheets("Sheet1") lr = scWS.Cells(scWS.Rows.Count, "B").End(xlUp).Row For r = 2 To lr xDate = scWS.Cells(r, "B").Value If xDate <> "" Then n = Format(DateSerial(2000 + Left(xDate, 2), _ Mid(xDate, 3, 2), _ Right(xDate, 2)), "dd/mm/yyyy") scWS.Cells(r, "D").Value = n End If Next r End Sub New Microsoft Excel Worksheet.xlsx1 point
-
شكرا اخي الحبيب ابو خليك اخوتي البرنامج هو الديلفي Delphi وانا استخدم النسخة 11, لمن يريد ان يستخذم النسخة هنا وهي غير مجانية , تجد مع النسخة الكراك و التفعيل https://downloaddevtools.com/en/product/1/free-download-embarcadero-rad-studio-10-4-sydney ولكي لا اطول عليكم قمت بتصوير كل حركة قمت بها اثناء استعمال البرنامج , و للشرح بقية , ولكم مني اجمل شكر وهذه هي النتيجة في الصورة1 point
-
وعليكم السلام ورحمة الله وبركاته يمكن ينفع جرب النموذج في قاعدة موجودة عندك حتى ترى المعيار يتحرك حجم القاعدة.accdb1 point
-
نعم اخي @hanykassem نظرا للمثال المرفق هناك بعض الإحتمالات الواردة في حالة كان هناك تكرار لنفس القيم كما هو موضح في الصورة أدناه Private Sub Worksheet_Change(ByVal Target As Range) Dim WS As Worksheet: Set WS = Sheets("Sheet1") Dim i As Long, ling As Long, lastRow As Long, tmp As String, kayB As String, kayC As String, _ j As Variant, a As Object, r As Object Set a = CreateObject("Scripting.Dictionary"): Set r = CreateObject("Scripting.Dictionary") If Not Intersect(Target, WS.Range("A4:C" & WS.Rows.Count)) Is Nothing Then Application.ScreenUpdating = False With WS .Range("I3:K" & .Rows.Count).ClearContents lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ling = 3 For i = 4 To lastRow tmp = .Cells(i, 1).value kayB = .Cells(i, 2).value kayC = .Cells(i, 3).value If tmp <> "" Then If kayB <> "" Then a(tmp) = IIf(a.Exists(tmp), a(tmp) & " , " & kayB, kayB) If kayC <> "" Then r(tmp) = IIf(r.Exists(tmp), r(tmp) & " , " & kayC, kayC) End If Next i For Each j In a.Keys .Cells(ling, 9).value = j .Cells(ling, 10).value = a(j) .Cells(ling, 11).value = r(j) ling = ling + 1 Next j .Columns("j:K").AutoFit End With Application.ScreenUpdating = True End If End Sub لحدف التكرارات قم بتعديل الصف التالي If tmp <> "" Then If kayB <> "" Then a(tmp) = IIf(a.Exists(tmp), a(tmp) & " , " & kayB, kayB) If kayC <> "" Then r(tmp) = IIf(r.Exists(tmp), r(tmp) & " , " & kayC, kayC) End If إلى If tmp <> "" Then If kayB <> "" Then If Not a.Exists(tmp) Then a.Add tmp, _ kayB Else If InStr(1, a(tmp), kayB) = 0 Then a(tmp) = a(tmp) & " , " & kayB If kayC <> "" Then If Not r.Exists(tmp) Then r.Add tmp, _ kayC Else If InStr(1, r(tmp), kayC) = 0 Then r(tmp) = r(tmp) & " , " & kayC End If TEST CODE 2.xlsb1 point
-
يمكنك تعديل كود عرض الأعمدة بترتيب العناصر على الشكل التالي Private Sub ContrArr(tmp As Long) Dim controls As Variant, columns As Variant, i As Integer controls = Array("TextBox7", "ComboBox1", "ComboBox2", "ComboBox3", "ComboBox4", _ "TextBox3", "TextBox4", "TextBox5", "TextBox6", "ComboBox5") columns = Array(2, 4, 5, 6, 7, 8, 9, 10, 11, 12) If Me.TextBox8.Text = "" Then ClearControls Else Me.TextBox8.Tag = tmp For i = LBound(controls) To UBound(controls) Me.controls(controls(i)).Text = WS.Cells(tmp, columns(i)).Value Next i tblUpdate tmp End If End Sub البحث والتنقل.rar1 point
-
1 point
-
كود للفرز بمعيارين ولكن به اضافه مفيده وهي ازاله المسافات من بين الاسماء مما تعطي فرزا دقيقا للمحترم الغالي ياسر العربي Dim lr As Long lr = Range("E" & Rows.Count).End(xlUp).Row For Each Cell In ActiveSheet.Range("E7:E" & lr) Cell.Value = Application.WorksheetFunction.Trim(Cell.Value) Next Range("B7:S" & lr).Sort Key1:=Range("F7:F" & lr), Order1:=2, Key2:=Range("E7:E" & lr), Order2:=1, Header:=xlNo End Sub1 point
-
بسم الله و ما شاء الله اللَّهُمَّ انْفَعْنَا بِمَا عَلَّمْتَنَا , وَعَلِّمْنَا مَا يَنْفَعُنَا , وَزِدْنَا عِلْمًا إِلَى عِلْمِنَا اهداء لكل من شارك بعلمه اقل ما يقال لكم "عندما تنتهى كلمات الابداع و تبدأ من جديد و تنتهى عندكم" بارك الله لكم ( فكرة المدونة هى سهولة الوصول و البحث فى المنتدى للذهاب الى ملف _ المدونه الاصدار الاول من هنا مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_سلسله تجميعيه فورم لادراج صور وحفظها والتعديل عليها مع قاعدة بيانات أ / رحمه الله عماد الحسامى جلب الصور بواسطة المعادلات فقط_ أ / رحمه الله عماد الحسامى موضوع مميز_البوم صور و معروضات _ أ / رحمه الله عماد الحسامى و مشاركات الاعضاء الاصدار الرابع : فورم اضافة وبحث وتعديل مرن مع استعراض الصور (تحكم كامل بالصورة )_ _ أ / عبدالله باقشير إضافة واستعراض صور والبحث عنها من خلال فورم - هدية رمضان _ أ / ابو عبدالله_اكسلجى كود حذف و لصق لجميع الصور بورقة العمل _ أ / ابو عبدالله_اكسلجى بالكود استدعاء بيانات مصحوبه بالصوره _ أ / ابو عبدالله_اكسلجى ربط صور الموظفين باسماؤهم بالقائمة المنسدله _ أ / ابو عبدالله_اكسلجى موضوع مميز_إدراج فيديو_صور متحركة داخل ورقة العمل_شيت اكسيل _ أ / ابو عبدالله_اكسلجى دالـة ( VLOOK_Pic1 ) لعـرض الصـور من أى نـوع و أى حجـم _ أ / أبو تامر_عمر الحسينى إدراج الصـورة فـى تعليق الخليـة أتـومـاتيكيـا مع التحكم بحجمها _ أ / أبو تامر_عمر الحسينى البوم للصور والمعروضات, بدون حدود _ أبو تامر _ عمر الحسينى اضافة صورة الى تعليق الخلية _ أ / أبو تامر_عمر الحسينى إكسيل كاميرا _ أبو تامر _ عمر الحسينى إدراج صور داخل التعليقات بناءً على قائمة بأسماء ملفات الصور Create Comments With Pictures From File List _ أ / ياسر خليل أبو البراء عرض صور المنتج و معلوماته داخل يوزر فورم _ أ / ياسر العربى البحث عن الصور _ الاستاذ / محمد الريفى ملف لاستعراض صور المخزون عن طريق الفورم _ مشاركات الاعضاء جلب صورة الموظف بدلالة الرقم القومى _ _ أ / سعيد بيرم بطاقة التلميذ مع الصوره_ أ / طارق محمود برنامج جاهز_تحويل صوره و نسخها الى خلايا اكسيل _ أ / onlymanly قائمه منسدله للصور _ أ / ابو اسامة العينبوسي1 point
-
تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة كيف اربط الصور بالقائمه المنسدله تم ارفاق كود الحل من الفاضل ا / أبوعبد الله مرفق الملف بيانات الموظفين-1.rar و لا تنسونا من صالح الدعاء تحياتى1 point