عبدالله باقشير

هذا الكود Sub CH() kh_ColumnHidden "C:W" End Sub

السلام عليكم ضع هذه المعادلة في الخلية B4 في ورقة السجل =IFERROR(VLOOKUP($B$1;OFFSET(INDIRECT(ADDRESS(6;2;;;$A4));;;42;16);8;0);"") واسحبها على الصفوف

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

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

السلام عليكم Sub kh_Start() Dim cel As Range Dim NamSheet As String Application.ScreenUpdating = False For Each cel In Range("E10:E29") NamSheet = Trim(cel) If Len(NamSheet) = 0 Then GoTo 1 If IsError(Evaluate("'" & NamSheet & "'!A1")) Then Call kh_CopySheet(NamSheet) End If 1 Next Application.ScreenUpdating = True End Sub Sub kh_CopySheet(iName As String) Sheets("المحصلة").Copy After:=Sheets(Sheets.Count) With Cells.Worksheet .Name = iName .[k1] = iName End With End Sub شاهد المرفق 2010 برنامج سجل الصفوف.rar

اخي الحبيب احمد فضيلة

السلام عليكم الاخ محمد عبارة الاخ fideletoi جزاكم الله خيرا =========================================== الاخ deebsagheer الحجم المخصص للصورة صغير جزاكم الله خيرا =========================================== الاخ محمد تومي اعتقد عندك خطا في كود فتح الفورم .kh_SetAddrss "مثال1", "D10:S10" في اسم الورقة او في النطاق...........والله اعلم

السلام عليكم هذه المعادلة باستخدام دالة SumIfs =SUMIFS(FB_STORE_BASE!$U$11:$U$249999;FB_STORE_BASE!$K$11:$K$249999;A11;FB_STORE_BASE!$B$11:$B$249999;"<="&FB_STORE_BASE!$B$9) وهذه المعادلة داخل الكود Sub RoundedRectangle1_Click() With Range("K11:K" & [A5000].End(xlUp).Row) .FormulaR1C1 = _ "=SUMIFS(FB_STORE_BASE!R11C21:R249999C21,FB_STORE_BASE!R11C11:R249999C11,RC[-10],FB_STORE_BASE!R11C2:R249999C2,""<=""&FB_STORE_BASE!R9C2)" .Value = .Value End With End Sub تحياتي

السلام عليكم لكن لماذا لا تستخدم دالة SumIfs عموما جرب هذا الكود Sub RoundedRectangle1_Click() With Range("K11:K" & [A5000].End(xlUp).Row) .Cells(1, 1).FormulaArray = _ "=kh_SumIf(FB_STORE_BASE!R11C21:R249999C21,FB_STORE_BASE!R11C11:R249999C11=RC[-10],FB_STORE_BASE!R11C2:R249999C2<=FB_STORE_BASE!R9C2)" .Cells(1, 1).AutoFill Destination:=.Cells .Value = .Value End With End Sub تحياتي

ممكن بواسطة قاعدة التحقق من صحة البانات ادخال رسالة

اخي الفاضل أبا عمر و

السلام عليكم يا اخي الفورم فيه امكانيات كثيرة فهو ينقل المعادلات والتنسيقات تلقائيا الى السجل الجديد بس انت مش عامل رؤوس الاعمدة بالشكل الصحيح عدل كود فتح الفورم بهذا Sub kh_Show_UFormChang2() On Error GoTo 1 With UFormChang .kh_SetAddrss "تعديل", "b8:r8", "a8" .Show End With 1: If Err Then MsgBox "تاكد من صحة ادخال المتغيرات الاساسية في : " & vbCr & vbCr & "kh_SetAddrss", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "استخدام خاطىء" On Error GoTo 0 End Sub تحياتي

السلام عليكم اخي خزاني ....الله يسلمك

السلام عليكم من خصائص TextBox في الخاصية PasswordChar اكتب نجمة شاهد الصورة

اخي الحبيب ضاحي الغريب

الله اعلم

تقصد خط الليبل .........الله اعلم

السلام عليكم Private Sub UserForm_Initialize() Dim i As Integer For i = 1 To 7 Me.Controls("Label" & i).Caption = Cells(2, i).Value Next i For i = 1 To 2 Me.Controls("Lab" & i).Caption = Range("B1,E1").Areas(i) Next i End Sub

تفضل Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:A")) Is Nothing Then If Target.Offset(0, 1) = "" Or Not IsNumeric(Target.Offset(0, 1).Value) Then Cells(Target.Row, 3) = Format(Now, "hh:mm:ss") End If End If End Sub

Sub Macro1() MsgBox Format(Now, "hh:mm:ss") End Sub

=TEXT(NOW();"hh:mm:ss")

اخي الحبيب محمد أبو البراء

اخي الحبيب قصي

اخي الفاضل مراد