Ali Mohamed Ali

من فضلك اخى الكريم لا تبخل بنجاح المشاركة فليس هناك وجود لأى مشاركة الا بعد تدعيمها بملف مشروح فيه كل المطلوب بكل دقة والا فكان عليك لزاماً استخدام خاصية البحث بالمنتدى قبل رفع هذه المشاركة طالما انك لم تقم برفع ملف !!! ولا تقول ان المشاركة بسيطة لا تحتاج لكل هذا ... فان كان طلبك بسيط لأستطعت انت بنفسك حله ولا احتجت لمساعدة الأخرين فى حل مشكلتك وتفريج كربتك تفضل هذا الكود Sub Unhide_All_Sheets() Dim ws As Worksheet ActiveWorkbook.Unprotect For Each ws In Worksheets ws.Visible = xlSheetVisible Next End Sub وهذا كود أخر Sub Unhide_All_Sheets_Count() Dim wks As Worksheet Dim count As Integer count = 0 For Each wks In ActiveWorkbook.Worksheets If wks.Visible <> xlSheetVisible Then wks.Visible = xlSheetVisible count = count + 1 End If Next wks If count > 0 Then MsgBox count & " worksheets have been unhidden.", vbOKOnly, "Unhiding worksheets" Else MsgBox "No hidden worksheets have been found.", vbOKOnly, "Unhiding worksheets" End If End Sub وهذا كود ثالث Sub Unhide_Selected_Sheets() Dim wks As Worksheet Dim MsgResult As VbMsgBoxResult For Each wks In ActiveWorkbook.Worksheets If wks.Visible = xlSheetHidden Then MsgResult = MsgBox("Unhide sheet " & wks.Name & "?", vbYesNo, "Unhiding worksheets") If MsgResult = vbYes Then wks.Visible = xlSheetVisible End If Next End Sub وهذا كود رابع Sub Unhide_Sheets_Contain() Dim wks As Worksheet Dim count As Integer count = 0 For Each wks In ActiveWorkbook.Worksheets If (wks.Visible <> xlSheetVisible) And (InStr(wks.Name, "report") > 0) Then wks.Visible = xlSheetVisible count = count + 1 End If Next wks If count > 0 Then MsgBox count & " worksheets have been unhidden.", vbOKOnly, "Unhiding worksheets" Else MsgBox "No hidden worksheets with the specified name have been found.", vbOKOnly, "Unhiding worksheets" End If End Sub اختر منهم ما يناسبك عرفت ان كده اهدار للوقت لأنك لم تقم من البداية برفع الملف فالخطأ عندك ,فالملف لم تقم بوضع اى كود به-تفضل بعد وضع الكود يعمل بكل كفاءة مثال.xlsm

تفضل -يمكنك استخدام هذه المعادلة =COUNTIFS($B$4:$B$28,I$4,$C$4:$C$28,"*"&$H5&"*") SAME1.xlsx

أخى الكريم انا لم أحذف شيئاً من ملفك فقط قمت بعمل ما تريد وهو ظهور أسماء الزبائن بدون تكرار بالقائمة المنسدلة وشكراً على تأخر ردك

وعليكم السلام-تفضلى goto the page with pass1.xls

وعليكم السلام -يمكنك استخدام هذه المعادلة لذلك ... وأيضاً بالملف يوجد أربعة معادلات أخرى =LOOKUP(1,0/('1'!$A$3:$A$600=$A3)/('1'!$B$3:$B$600=$B3),'1'!$C$3:$C$600) test match price1.xlsx

وعليكم السلام-لكى يتحقق ما تريد عليك بإستخدام هذه المعادلة =(INT(A2)+(A2-INT(A2))*100/60)*C2 الأضافى1.xls

وعليكم السلام-لك ما طلبت test search1.xlsx

جرب كده أعتقد لا يوجد مشكلة الأن SHAIMA1 H.xlsm

وعليكم السلام - يمكنك استخدام هذه المعادلة =IFERROR(index($C$5:$C$51,match(0,index(countif($AF$4:af4,$C$5:$C$51),),0)),"") الحساب اليومي1.xlsx

وعليكم السلام لا يمكنك عمل هذا بمعادلة فلكوب العادية الا بعد عمل عمود مساعد او يمكنك استخدامها بطريقة مباشرة بعد جلب أول عمود بالفاتورة بهذه المعادلة المصفوفة (Ctrl+Shift+Enter) =IFERROR(INDEX(التفاصيل!$C$4:$C$800,SMALL(IF($F$6=التفاصيل!$A$4:$A$800,ROW($A$4:$A$800)-3),ROW(A1))),"") برنامج فواتير.xlsx

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

تفضل لا يمكنك العمل بهذه الدالة قبل 1900 ولكن هناك دالة معرفة وهى XDATEYEARDIF ..... وهذا هو كودها Function XDATEYEARDIF(xdate1, xdate2) As Long Dim YearDiff As Long Dim i As Long, D1 As String, D2 As String D1 = xdate1 For i = 1 To 7 D1 = Replace(D1, Format(i, "dddd"), "") D1 = Replace(D1, Format(i, "ddd"), "") Next i D2 = xdate2 For i = 1 To 7 D2 = Replace(D2, Format(i, "dddd"), "") D2 = Replace(D2, Format(i, "ddd"), "") Next i YearDiff = Year(D2) - Year(D1) If DateSerial(Year(D1), Month(D2), Day(D2)) < CDate(D1) Then YearDiff = YearDiff - 1 XDATEYEARDIF = YearDiff End Function اشخاص - 1.xlsm

وعليكم السلام-تفضل هذا الكود Sub PrintPDF() Call Save_PDF End Sub Function Save_PDF() As Boolean Dim Thissheet As String, ThisFile As String, PathName As String Dim SvAs As String Application.ScreenUpdating = False Thissheet = ActiveSheet.Name ThisFile = ActiveWorkbook.Name PathName = ActiveWorkbook.Path SvAs = PathName & "\" & Thissheet & ".pdf" On Error Resume Next ActiveSheet.PageSetup.PrintQuality = 600 Err.Clear On Error GoTo 0 On Error GoTo RefLibError ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True On Error GoTo 0 SaveOnly: MsgBox "A copy of this sheet has been successfully saved as a .pdf file: " & Chr(13) & Chr(13) & SvAs & _ "Review the .pdf document. If the document does NOT look good, adjust your printing parameters, and try again." Save_PDF = True GoTo EndMacro RefLibError: MsgBox "Unable to save as PDF. Reference library not found." Save_PDF = False EndMacro: End Function وتم تجربة الكود على الطابعة , يعمل بنجاح وهذا هو الدليل قمت بعمل سكان لك للورقتين Scan1.pdf Scan2.pdf A4 VERSION1.xlsm

وعليكم السلام -تفضل تم عمل قوائم منسدلة لتسهيل الإدخال بصفحة العمليات .. كما تم منع ادخال المكرر بعمود الرمز وعمود الإسم كماتم الإستعانة بكود من أكواد استاذنا الكريم سليم حاصبيا للترحيل , له منا كل المحبة والإحترام وأعانه الله دائما على مساعدة الجميع وهو : Option Explicit Sub Salim_code() Application.ScreenUpdating = False Dim Filt_Rg As Range Dim M As Worksheet Dim Sh As Worksheet Dim i% Set M = Sheets("العمليات") Set Filt_Rg = M.Range("A12").CurrentRegion If M.AutoFilterMode Then Filt_Rg.AutoFilter End If i = 4 Do Until M.Range("F" & i) = vbNullString If Not Application.Evaluate("ISREF('" & M.Range("F" & i) & "'!A1)") Then Sheets.Add(, M).Name = M.Range("F" & i) End If i = i + 1 Loop For Each Sh In Sheets If Sh.Name <> M.Name Then Sh.Range("B1").CurrentRegion.Clear Filt_Rg.AutoFilter 6, Sh.Name Filt_Rg.SpecialCells(12).Copy Sh.Range("B1") Sh.Range("B1").CurrentRegion.Columns.AutoFit End If Next M.Select If M.AutoFilterMode Then Filt_Rg.AutoFilter End If Application.ScreenUpdating = True End Sub تجربة ملاك 2020.xlsb

تفضل هذه المعادلة لعد أحرف الخلية =LEN(A4) أما بالنسبة لتحديد كتابة 31 حرف أو أقل فقط بالخلية فهذا يتم من خلال DataValidation كما بالصورة وتم تنفيذ ذلك على الملف بالفعل دالة عدد الاحرف.xlsx

تفضل اخى الكريم -يمكنك استخدام هذا الكود ... تم التعــديــل من فضلك عليك بأستخدام خاصية البحث بالمنتدى قبل رفع مشاركتك حتى لا يتم اهدار مزيد من الوقت فى موضوعات قد تكررت وتم تناولها عشرات المرات Sub Test() Dim rng1 As Range Dim str_search As String ThisWorkbook.Sheets("البداية").Activate str_search = Range("b6").Value ThisWorkbook.Sheets("التقرير").Activate Set rng1 = Sheets("التقرير").Range("a:a").Find(str_search, , xlValues, xlWhole) If rng1 Is Nothing Then Dim lastRow As Long lastRow = ThisWorkbook.Sheets("التقرير").Range("A1000000").End(xlUp).Row lastRow = lastRow + 1 With ThisWorkbook.Sheets("التقرير") .Range("A" & lastRow).Value = Sheets("البداية").Range("B6").Value .Range("B" & lastRow).Value = Sheets("البداية").Range("B7").Value .Range("C" & lastRow).Value = Sheets("البداية").Range("B8").Value End With Sheets("البداية").Range("B6").Value = "" Sheets("البداية").Range("B7").Value = "" Sheets("البداية").Range("B8").Value = "" Else MsgBox str_search & " موجود مسبقا" ThisWorkbook.Sheets("البداية").Activate End If End Sub test 3.xlsm

وعليكم السلام-تم عمل المطلوب وزيادة ... فقد تم تنسيق شكل الفاتورة وعمل قواءم منسدلة لأسماء الأصناف وأسماء العملاء حتى يتم الأختيار من بينهم وان لا يوجد مجال للخطأ عند الكتابة -بارك الله فيك وأتمنى ان ينال إعجابك فاتورة_3.xlsm

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

بارك الله فيك استاذ محي ... ولإثراء الحل -يمكنك استخدام هذه المعادلة , مصفوفة (Ctrl+Shift+Enter) =SUMPRODUCT(0+(0&TRIM(MID(SUBSTITUTE(B2,"+",REPT(" ",10)),ROW($A$1:$A$10)*10-9,10)))) معادلة جمع1.xlsm

يمكنك هذا بهذه المعادلة =IF(ROWS($A$1:A1)>DAY(EOMONTH(DATE($D$2,$F$2,1),0)),"",DATE($D$2,$F$2,ROWS($A$1:A1))) 81.xlsx

تفضل اليك طلبك - وهذا شكل القائمة المنسدلة بالملف المرفق ... كما بالصورة 0001 .xlsm

وعليكم السلايمكنك استخدام هذا الكود لذلك 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