Ali Mohamed Ali

وعليكم السلايمكنك استخدام هذا الكود لذلك Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If (Not Application.Intersect(Target, Me.Range("d9:M18,D19:E19")) Is Nothing) Then Cancel = True Target.Interior.ColorIndex = 15 End If End Sub Cells Colored.xlsm

بارك الله فيك استاذ صالح وجعل هذا العمل فى ميزان حسناتك - ورحم الله والديك , اللهم اجعلهم فى اعلى الدرجات وأدخلهم فسيح جناتك ... جنات الفردوس الأعلى واغفر لهم وارحمهم اللهم وسع فى رزقك استاذ صالح واصلح لك اولادك واجعلهم يارب ممن يستمعون القول فيتبعون احسنه وبارك اللهم لك فيهم

أحسنت استاذ أحمد بارك الله فيك

يمكنك استخدام هذه المعادلة =IFERROR(LOOKUP(1,0/(tarheel!$C$2:$C$200=$C$1)/(tarheel!$B$2:$B$200=E$2),tarheel!$A$2:$A$200),"") ترحيل3.xlsm

وعليكم السلام كان عليك لزاما استخدام خاصية البحث بالمنتدى قبل رفع مشاركتك فقد تم تناول هذا الموضوع مرات عدة ومنها ربط الصورة بالإسم وهذا فيديو أيضاً للشرح ويمكنك تحميل ملف الشرح أسفل الفيديو استدعاء صورة الموظف من مجلد بالاكسيل Vlookup Picture VBA بعد كل هذا فقمت بحل طلبك بدالة معرفة ... فيمكنك وضع هذه المعادلة ابتداءا من الخلية B2 سحباً للأسفل =IF(A2="","",VLOOK_Pic1($A2)) وهذا هو كود الدالة Function VLOOK_Pic1(PicName) Dim CurrentCel As Range, Pic As Shape PicName = PicName: MyPath = ThisWorkbook.Path & "\Data\": PicName = MyPath & PicName: ChkPic = Array(".jpg", ".bmp", ".gif", ".png") Set CurrentCel = Application.Caller Set CurrentCel = CurrentCel.MergeArea For Each Pic In ActiveSheet.Shapes If Pic.Type = msoLinkedPicture Then If Pic.Top >= CurrentCel.Top And Pic.Top < CurrentCel.Top + CurrentCel.Height Then Pic.Delete Exit For End If End If Next For X = LBound(ChkPic) To UBound(ChkPic) If Not Dir(PicName & ChkPic(X), vbDirectory) = vbNullString Then Set Pic = ActiveSheet.Shapes.AddPicture(PicName & ChkPic(X), True, False, CurrentCel.Left, CurrentCel.Top, CurrentCel.Width, CurrentCel.Height): VLOOK_Pic1 = "" Exit For Else VLOOK_Pic1 = "لا توجد صورة" End If Next End Function khalid.rar

يمكنك استخدام هذا الكود -فقد تم ضبط الملف و عمل قائمة منسدلة ديناميكية وبدون فراغات لأسماء العملاء ... كما تم ادخال معادلة أيضاً لمعرفة طبيعة كل صنف هل بالكيلو ام بالحبة Sub TARHEEL() If IsEmpty(Cells(5, 2)) Then MsgBox "يــرجــى إدخــال رقــم الفــاتــورة" Exit Sub End If Dim R As Integer Dim xNewR As Integer For R = 14 To 23 If IsEmpty(Cells(R, 2)) Then Exit Sub xNewR = Sheets("SLS").Cells(1, 1).CurrentRegion.Rows.Count + 1 Sheets("SLS").Cells(xNewR, 1) = Cells(5, 2) Sheets("SLS").Cells(xNewR, 2) = Cells(5, 6) Sheets("SLS").Cells(xNewR, 3) = Cells(7, 3) Sheets("SLS").Cells(xNewR, 4) = Cells(8, 3) Sheets("SLS").Cells(xNewR, 5) = Cells(R, 1) Sheets("SLS").Cells(xNewR, 6) = Cells(R, 2) Sheets("SLS").Cells(xNewR, 7) = Cells(R, 3) Sheets("SLS").Cells(xNewR, 8) = Cells(R, 4) Sheets("SLS").Cells(xNewR, 9) = Cells(R, 5) Sheets("SLS").Cells(xNewR, 10) = Cells(R, 6) Cells(R, 2) = "" Cells(R, 4) = "" Cells(R, 5) = "" Next Do Loop Cells(5, 2) = "" End Sub كود ترحيل الفاتورة.xlsm

طبعاً بعد اذن استاذنا عبد الرحيم ... ولإثراء الحل - تفضل على الرغم من تكرار هذه الموضوعات بالمنتدى 19.xlsm

بارك الله فيك استاذ أحمد وزادك الله من فضله

تفضل يمكنك استخدام هذه المعادلة =SUMPRODUCT(SUMIF(INDIRECT("'"&sheets&"'!"&"b2:b100"),A2,INDIRECT("'"&sheets&"'!"&"d2:d100"))) تجريبى1.xlsx

وعليكم السلام-يمكنك استخدام هذه المعادلة ...وان لم يكن هذا المطلوب فعليك تنظيم ملفك وشرح المطلوب بكل دقة =SUMIFS($E$39:$E$375,$F$39:$F$375,B$5,$A$39:$A$375,$A6) شغل لوادروسيارات1.xlsx

وعليكم السلام-تفضل قوائم 2021-.xlsb

تفضل لك ما طلبت قائمة منسدلة.xlsx

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

بارك الله فيك استاذ ابراهيم وزادك الله من فضله وان شاء الله يكون برنامج ممتاز وفتحة خير عليك ان شاء الله .... جعله الله فى ميزان حسناتك ورحم الله والديك

وعليكم السلام -فقط للحفظ التلقائى ... عليك بوضع هذا الكود فى حدث ThisWorkBook Private Sub Workbook_BeforeClose(Cancel As Boolean) If Saved = False Then ActiveWorkbook.Save End If End Sub Protect.xlsb

فقط عليك استخدام هذه الصيغة ... سحباً للأسفل =RC[-2]&" "&RC[-1] دمج.xlsb

بارك الله فيك أستاذ حسام , وجعله فى ميزان حسناتك ورحم الله والديك

وعليكم السلام-تفضل لك ما طلبت 1نموذج.xlsm

وعليكم السلام-فقط يمكنك وضع هذا الكود فى حدث ThisWorkBook Private Sub Workbook_Open() If Range("C5").Value = Range("C12").Value Then Sheet1.Range("e5:e12").ClearContents End If End Sub كود بشرط.xlsm

وعليكم السلام-يمكنك هذا بهذه المعادلة =IFERROR(LOOKUP(2,1/(Export[Year]=$B$4),Export[Month]),"") Last Text1.xlsx

وعليكم السلام -يمكنك هذا بمعادلة المصفوفة =IFERROR(INDEX(Mapping!$A$2:$A$178,SMALL(IF(Mapping!$B$2:$B$178=$A$4,ROW(A$2:A$178)-ROW(A$2)+1),ROWS($A$6:A6))),"") Rank Country.xlsm

كان عليك توضيح هذا الطلب من البداية تجنباً لعدم اهدار الوقت -تفضل يمكنك هذا بذلك الكود Private Sub CommandButton1_Click() On Error Resume Next Dim ws As Worksheet Set ws = Sheets("Sheet1") Me.TextBox2.Value = Me.TextBox1.Value * WorksheetFunction.VLookup(Me.ComboBox1.Value, ws.Range("a2:d20"), 2, 0) Me.TextBox3.Value = Me.TextBox1.Value * WorksheetFunction.VLookup(Me.ComboBox1.Value, ws.Range("a2:d20"), 3, 0) Me.TextBox4.Value = Me.TextBox1.Value * WorksheetFunction.VLookup(Me.ComboBox1.Value, ws.Range("a2:d20"), 4, 0) End Sub 2حساب النسبة المئوية.xlsm

وعليكم السلام-عليك التحلى بالصبر وكان عليك رفع ملف مصغر كنموذج وليس كل هذا الملف تفضل لك ما طلبت تم عمل قائمة منسدلة بأسماء المقاولين .... وأعتقد انه ليس هناك داعى لعمل صفحات مستقلة بأسماء المقاولين لأن هذا سيثقل من حجم الملف ويبطئه , فقط عليك اختيار اسم المقاول من القائمة المنسدلة واترك الباقى على الإكسيل-بارك الله فيك حساب توريدات٢٠٢1.xlsx

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

وعليكم السلام -يمكنك استخدام هذه المعادلة لطلبك =IF(ROWS($G$12:G12)>DAY(EOMONTH(DATE($O$3,$P$4,1),0)),"",DATE($O$3,$P$41,ROWS($G$12:G12))) كشف الحضور1.xlsm