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

ربما بهذه الحلقة تكفي: For i = 1 To 14 formOrReport.Controls("txt" & i) = Mid(nationalID, i, 1) Next i

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Sub SaveAsPDF11() Dim WS As Worksheet, CrWS As Worksheet Set WS = ActiveSheet: Set CrWS = Sheets("مشروع 1") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False WS.Range("B2:I47").FormatConditions.Delete WS.Range("A1:Z999").AutoFilter Field:=1, Criteria1:="<>" savePath = "d:\" & WS.Range("AA1").Value & " " & Format(Now, "yyyy-mm-dd,hh.mm") & ".pdf" WS.Range("A1:Z999").ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath CrWS.Range("B2:I47").Copy WS.Range("B2").PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub

كرري التحديث للنماذج الثلاث Private Sub n1_Change() [Form1].Requery [Form2].Requery [Form3].Requery End Sub

السلام عليكم بالدوال عن طريق عمود مساعد في X شيت.xlsx او كود شيت.xlsb

اخى الفاضل [ kkhalifa1960 ] لك منى كل احترام وتقدير على مجهودك " بارك الله فيك " تم عمل اللازم واكتر مما توقعت والنموذج المرفق سهل عليه حاجات كتير جدا بعد كدا فى البرنامج ( وفيت واستوفيت )

تفضل استاذ @Lotfy14 مرفقك بعد التعديل . راجعه ووافني بالرد . lotfy@14-112.rar

شكرا شكرا شكرا ، ده المطلوب تماما ، الف شكر لحضرتك

للإثراء ،،، من مكتبتي العامرة 😊 3 أكواد لـ ( نسخ - لصق - تفريغ الذاكرة ) شرح الكود: ضع الكود كاملا في موديول ثم استخدمه في البرنامج كما هو واضح في الأسفل .. الكود: '==================================================(Copy) Public Function CopyText(ByVal Text As Variant) As Boolean CopyText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text) End Function '==================================================(Paste) Public Function PasteText() As String On Error Resume Next PasteText = CreateObject("htmlfile").ParentWindow.ClipboardData.getData("Text") End Function '==================================================(Clear The ClipBoard) Public Function ClearClipBoardText() As Boolean ClearClipBoardText = CreateObject("htmlfile").ParentWindow.ClipboardData.clearData("Text") End Function طريقة الاستدعاء (الاستخدام): CopyText(Text) <------ للنسخ PasteText() <------ للصق ClearClipBoardText() <------ تفريغ الذاكرة مرجع: #https://www.mrexcel.com/board/threads/vba-post-to-clipboard.1142841/# مكتبة الأكواد

وعليكم السلام ورحمة الله وبركاته طريقتان واختاري ما يتاسبك الاولى ان يكون الملفان مفتوحان في نفس الوقت ونفس المجلد وبنفس الاسم تحديث عدد الطلاب2 ( يمكن تعديله من الكود) ملف الطلاب الاصل.xlsb الثانية الملف مقفول وبأي اسم بمعنى عند الضغط على زر تحديث البيانات تظهر واجهة نخنار الملف المراد اخد البيانات منه ملف الطلاب الاصل2.xlsb اتمنى ان يكون طلبك في احد الملفين لك كل التقدير والاحترام

تفضل استاذ @تامر خليفه المرفق وبه الثلاث طلبات . DDTempTest 003.rar

بيض الله وجهك .... فعلا عملت قاعدة جديدة فارغة وطبقت الخطوات وعمل بشكل سليم ما رأيك بهذا وجدته في أحد المنتديات الاجنبية ويقوم بنفس العمل With CreateObject("htmlfile") .parentWindow.clipboardData.clearData ("Text") End With

وعليكم السلام ورحمة الله تعالى وبركاته Option Explicit Sub CopyData() Dim ColArr() As Variant, Irow&, lr& Dim OnRng As Range, f As Worksheet Dim WS As Worksheet: Set WS = Sheets("ملخص") Application.ScreenUpdating = False WS.Range("A2:Q" & WS.Rows.Count).ClearContents For Each f In ThisWorkbook.Sheets If f.Name <> WS.Name Then Irow = f.Cells(f.Rows.Count, "D").End(xlUp).Row If Irow > 2 Then If WS.Cells(2, 1).Value = "" Then WS.Range("A2:Q2").Value = f.Range("A2:Q2").Value End If Set OnRng = f.Range("A3:Q" & Irow) ColArr = OnRng.Value lr = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row + 1 WS.Cells(lr, "A").Resize(UBound(ColArr, 1), UBound(ColArr, 2)).Value = ColArr End If End If Next f Application.ScreenUpdating = True End Sub Book1 v2.xlsb

وعليكم السلام ورحمة الله تعالى وبركاته lr = Cells(Rows.Count, 2).End(3).Row تحديد رقم الصف الأخير في العمود B الذي يحتوي على بيانات End(3) هي اختصار للخاصية xlUp التي تعني التحرك صعودا في العمود حتى تصل إلى أول خلية تحتوي على بيانات x = الصف الذي يبدأ منه النطاق المحدد Set my_rg = Range("A" & x & ":A" & lr).SpecialCells(4) لتحديد الخلايا داخل نطاق معين و هو اختصار للخاصية xlCellTypeBlanks التي تعني الخلايا الفارغة إدن بعد تحديد صف بداية النطاق وليكن مثلا الصف 5 الكود Option Explicit Sub test() Dim lr As Long, x As Long, my_rg As Range On Error Resume Next lr = Cells(Rows.Count, 2).End(3).Row x = 5 Set my_rg = Range("A" & x & ":A" & lr).SpecialCells(4) If Not my_rg Is Nothing Then my_rg.EntireRow.Delete End If On Error GoTo 0 End Sub لنفترض ان اخر خلية في العمود B هي 100 إذا كان هناك خلايا فارغة في العمود A ضمن النطاق A5:A100 سيتم حذف الصفوف التي تحتوي على هذه الخلايا مع تجاهل الخلايا التي تتضمن قيم أو معادلات

انظر الفرق والتغيير بين الكودين الكود الأول يزيل كلمة New folder المثبتة ضمن الكود وعدد الأحرف = 12 الثاني : لا يوجد كلمة محددة .. فقط يكتفى بعدد الحروف التي = 6

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

يوجد شيت صلاحية مستخدمين للاستاذ ضاحى Dahy 1234 ZAD IPTV Subscription.xlsm

جرب هذا التعديل maachat1.xlsx

جرب المرفق كشف الحساب OK.xlsm

السلام عليكم dashboared موضوع يحناج الى من يتقن اعداد الجدوال بالاكسل مثل جدول الموظفات الجدد في صفحة وجدول المواضيع في صفحة وجدول الاجتماعات في صفحة واستخدام معادلة COUNTIF لحساب عدد الموظفات وعدد المواضيع المفعلة وغيرها ثم بانشاء صفحة داش بورد والتي تتطلب منك اتقان الرسوم البيانية والجداول المحورية والتي يكون مصدر بياناتها الصفحات الاخري عند النغيير في اي بيان في الصفحات يتم تغييره تلقائيا في الرسوم البيانية والجداول المحورية ابحثى في اليوتيوب به الكثير من الدروس هذا احداها اليك ملف يمكنك التعديل عليه dashboared.xlsx

20244شيت مدرستى الصف السادس.xlsb

وعليكم السلام ورحمة الله وبركاته جرب الملف حيث يتم انشاء مجلد في نفس مسار الملف 20244شيت مدرستى الصف السادس.xls

السلام عليكم ورحمة الله محاولة في الملف المرفق... Track.xlsb

جزاكم الله خير

السلام عليكم قم بتفعيل الماكرو الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$G$2" Then Dim wsReport As Worksheet Dim wsSearch As Worksheet Dim lastRow As Long Dim i As Long Dim searchDate As Date Set wsReport = ThisWorkbook.Sheets("REPORT") Set wsSearch = ThisWorkbook.Sheets("Search2") searchDate = wsSearch.Range("G2").Value wsSearch.Range("B4:G1000").ClearContents lastRow = wsReport.Cells(wsReport.Rows.Count, "D").End(xlUp).Row Dim rowIndex As Long rowIndex = 4 For i = 2 To lastRow If wsReport.Cells(i, "D").Value = searchDate Then wsSearch.Cells(rowIndex, "B").Value = rowIndex - 3 wsSearch.Cells(rowIndex, "C").Value = wsReport.Cells(i, "G").Value wsSearch.Cells(rowIndex, "F").Value = wsReport.Cells(i, "J").Value wsSearch.Cells(rowIndex, "D").Value = wsReport.Cells(i, "I").Value wsSearch.Cells(rowIndex, "E").Value = wsReport.Cells(i, "H").Value rowIndex = rowIndex + 1 End If Next i End If End Sub New Microsoft Excel Worksheet (1).xlsb

شكرا اخ حسونة

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته هذه نسخة جديدة بها تعديل بسيط نقل النص من إكسل او ورد إلى الأوتوكاد 1.xls

طيب على راحتك نحن نتعلم .. لنتجاوز أخطاءنا .. ونطبق الطرق السليمة كي نطور انفسنا كتابة الحقول بحروف عربية ستتعبك كثيرا ويصعب عليك التعلم .. تفضل : تم تحقيق طلبك كما تريده بالضبط من دون اي تعديلات على المرفق.. If Me.TXT = "مقيم" Then Me.Form.Filter = "مقيم like '" & "نعم" & "'" Me.Form.FilterOn = True ElseIf Me.TXT = "لديه كفيل" Then Me.Form.Filter = "[لديه كفالة] like '" & "نعم" & "'" Me.Form.FilterOn = True ElseIf Me.TXT = "لديه اقامة" Then Me.Form.Filter = "[لديه اقامة] like '" & "نعم" & "'" Me.Form.FilterOn = True End If test4.rar