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

السلام عليكم
ممكن بدون اكواد
حدد مربع النص واذهب الى شريط الصيغة
واعمل يساوي وحدد الخلية التي تريد تظهر محتوياتها في مربع النص
 
في امان الله

السلام عليكم
 
هذا تعديل طفيف على الكود لتحصل على التجميع في كود التقرير
Sub BB() Dim i As Long, ii As Long On Error Resume Next Range("c7:g55").ClearContents Set MySheet = Sheets("data") For i = 1 To 7 If i > 1 Then Range("C" & [d10000].End(xlUp).Row + 1) = "الأجمالي" Range("C" & [d10000].End(xlUp).Row + 2) = MySheet.Cells(7, i + 11) Range(MySheet.Cells(8, i + 11), MySheet.Cells(MySheet.Cells(Rows.Count, i + 11).End(xlUp).Row, i + 11)).Copy Range("d" & [d10000].End(xlUp).Row + 2 + T).PasteSpecial (xlPasteValuesAndNumberFormats) T = 1 Next  Application.CutCopyMode = False For i = 7 To 55     ''''''''''''''''''''     If CStr(Cells(i, "C")) = "الأجمالي" Then         Cells(i, "e").Resize(1, 3).Formula = "=SUM(R[-" & ii - 1 & "]C:R[-1]C)"         ii = 0     Else         ii = ii + 1     End If     ''''''''''''''''''''     If Cells(i, "d") >= 1 Then         Cells(i, "e") = Application.WorksheetFunction.SumIf(Sheets("saad").Range("b7:b5000"), Cells(i, "d"), Sheets("saad").Range("c7:c5000"))         Cells(i, "f") = Application.WorksheetFunction.VLookup(Sheets("report2").Range("d" & i), Sheets("data").Range("d6:e100"), 2, 0)         Cells(i, "g") = Val(Cells(i, "e")) * Val(Cells(i, "f"))     End If Next With Sheets("report2").[b6:g55]         .Font.NAME = "Arabic Typesetting"         .Font.Size = 14         .Font.Bold = True End With End Sub في امان الله

استخدم هذه المعادلة
=IF(AND(ISNUMBER(B2);COUNTIF(Data!$A$3:$C$1000;report!B2));"نعم";"") في امان الله

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

السلام عليكم
اولا:
استخدمنا الليست بوكس لسهولة
الاضافة والحذف والتعديل
ثانيا:
تم تصحيح المعادلة للاسم المعرف asd
لتعطينا النطاق بدون فراغات
 
=OFFSET(Sheet1!$B$3;;;COUNTA(OFFSET(Sheet1!$B$3;;;10000;1));1)    
 
شاهد المرفق 2003
استدعاء بيانات بشكل افقي و التعديل عليها 2.rar

السلام عليكم
 
حسب فهمي للطلب
تفضل المرفق 2003
223322.rar

السلام عليكم
 
استخدم الدالة SUMIF
 
ضع هذه المعادلة في الخلية E14
واسحبه على الصفوف الاربعة
 
 
=SUMIF($A$2:$A$10;D14;$L$2:$L$10)   في امان الله

السلام عليكم
استبدل هذا
 
Private Sub TextBox1_Change() Me.TextBox2 = "" Me.TextBox3 = "" Me.TextBox4 = "" Set sh2 = Sheets("sheet2") LR = sh2.[A1000].End(xlUp).Row For Each cl In sh2.Range("A2:A" & LR) If Val(Me.TextBox1) = cl Then  Me.TextBox2 = cl.Offset(0, 1)  Me.TextBox4 = cl.Offset(0, 2)  End If  Next End Sub   في امان الله

السلام عليكم
استخدم الكود التالي
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) Dim m On Error GoTo 1 m = WorksheetFunction.Match(CStr(Me.TextBox1), Range("a1:a6"), 0) 1: If Err Then     MsgBox "القيمة غير موجودة في القائمة"     Err.Clear     Cancel = True End If End Sub   في امان الله

السلام عليكم

 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then Cancel = True End Sub   في امان الله

السلام عليكم
 
استبدل هذه الاكواد للفورم

 
Private Sub CommandButton1_Click() Dim i As Integer '''''''''''''''' CommandButton1.Visible = False '''''''''''''''' With Me.MultiPage1.Pages     For i = 0 To .Count - 1         If Val(.Item(i).Controls(0).Caption) Then             kh_v i             UserForm1.Printform         End If     Next End With kh_Start End Sub Private Sub kh_v(P As Integer) Dim i As Integer '''''''''''''''' With Me.MultiPage1.Pages     For i = 0 To .Count - 1         If .Item(i).Index = P Then             .Item(i).Visible = True         Else             .Item(i).Visible = False         End If     Next End With End Sub Private Sub kh_Start() Dim i As Integer, t As Integer '''''''''''''''' With Me.MultiPage1.Pages     For i = 0 To .Count - 1         t = Val(Cells(i + 1, "A"))         .Item(i).Controls(0).Caption = t         .Item(i).Visible = t     Next End With ''''''''''''''''''''''''''''' CommandButton1.Visible = True End Sub Private Sub UserForm_Activate() kh_Start End Sub   المرفق 2003
طباعة في فورم لصفحات MultiPage.rar

السلام عليكم




Sub kh_Test() Dim i As Integer ''''''''''''''''''' For i = 1 To 100 If Val(Cells(i, "A")) > Val(Cells(i, "B")) Then Cells(i, "B").Value = Cells(i, "A").Value End If ''''''''''''' If Val(Cells(i, "A")) < Val(Cells(i, "C")) Then Cells(i, "C").Value = Cells(i, "A").Value End If Next ''''''''''''''''''' End Sub

السلام عليكم

في المرفق حل لما تريد

add_namesheet.rar

وهناك طريقة اخرى

شاهد الموضوع

http://www.officena.net/ib/index.php?showtopic=30460

السلام عليكم

استخدم هذه المعادلة للتنسيق الشرطي


=TEXT(D$3;"dddd")="الجمعة"

تفضل المرفق
work.rar