أحمد يوسف

بارك الله فيك أستاذ محمد كود رائع أما بالنسبة للطلب الثانى .. لأن الدخول الى المنتدى أصبح بالبريد الإلكترونى ( e-mail) وليس بأسم العضو

انتبه من فضلك استاذى الكريم قبل رفع المشاركة على ان تستخدم خاصية البحث بالمنتدى فطلبك تم تناوله ومناقشته كثير جداً وشوف بنفسك : كود التعبئة التلقائية التعبئة التلقائية للخلايا التعبئة التلقائية للبيانات باحتراف l سلسلة دروس الاكسيل

أحسنت استاذ عبد الفتاح فالملف يعمل بكل كفاءة وشوف بنفسك مجاهد2013 وهذه صورة بعد فتح الملف للتأكيد وبكده يجب غلق المشاركة 1402041816_-Copie.rar

Zakariadz Bms من فضلك تجنباُ لإهدار الوقت أتمنى وأرجو منكم سرعة الرد دائماً ولا تتأخر ,فهل يعقل ان أقوم بالرد عليك يوم الإثنين وترد عليا يوم الخميس ؟!!! لو ممكن تقوم بالنظر الى الملف وان لم يكن هذا هو المطلوب , فعليك بتوضيح المطلوب اكثر من ذلك مع وضع النتائج المطلوبة يدوياً وشكرا .. وأرجو سرعة الرد حتى يتم غلق المشاركة حساب الاجر الوحيد أوفيسنا1.xlsx

وعليكم السلام-تفضل =IF(AND($K$5="متزوج",$K$7>0,$K$6="ماكثة"),($K$7*600)+800,IF($K$6="عاملة",0,IF(AND($K$5="متزوج",$K$7=0),550,""))) حساب الراتب لجميع الوظائف 2022 ofsna (1).xlsm

انتبه من فضلك amermas .. الكود داخل الفورم يقوم بالترحيل بشكل ممتاز كما أخبرك استاذنا حسين مامون له منا كل المحبة والإحترام ..وشوف الصورة بتفسك خير دليل, وبكده اكتملت كل طلباتك ولابد من غلق المشاركة وعدم اهدار المزيد من الوقت ... فبهذا ..المشكلة لديك انت طالما ان أكثر من شخص جرب الكود وشكرا

انتبه من فضلك فقد تكررت هذه المشكلة كثيرا وتم تناولها كثير جدا بالمنتدى ... فكان عليك استخدام خاصية البحث بالمنتدى تجنباً لإهدار وقت الأساتذة : مشكلة في اللغة العربية

وعليكم السلام -تفضل هذا الحل بما انك لم تقم برفع الملف الذى يحتوى على الكود الذى به المشكلة .. فإن لم تستطع التطبيق وحل مشكلتك ... فلابد لزاماً من رفع الملف للوقوف على المشكلة والعمل على حلها من قبل الأساتذة وشكرا . Compile error: Constants, ...Declare statements not allowed وهذا كود أخر ... ولكنى لا أعلم هل سيفيد مشكلتك ام لا لأنه لا يمكن العمل على التخمين !!! Option Explicit Dim wb As Workbook Dim Cell, rng As Range Dim A(1 To 4) As String Dim arrData() As Variant Dim arrRow, lRow, lCol As Long Dim i1, i2, j1, j2 As Long 'Public ListGroup() Public Sub ArrayToFinnish() Dim Cell As String Dim aCell As Range A(1) = "Ship Via Description" A(2) = "Speditor" A(3) = "Planned Ship Date/Time" A(4) = "Weight" 'A(4) = "Customer Order" 'A(5) = "Customer Number" Sheet1.Activate lRow = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).row lCol = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column Set rng = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, lCol)) ReDim arrData(1 To lRow, 1 To UBound(A, 1)) 'ListGroup = arrData(1 To lRow, 1 To Ubound(A,1)) For i1 = 2 To lRow For j1 = 1 To UBound(A, 1) Set aCell = rng.Find(A(j1)) Cell = Sheet1.Cells(i1, aCell.Column).Value Select Case Cell Case Cell = "EXPRESS" Case Cell = "TRUCK" Case Cell = "CZ/DACHSER/Axis Communications LLC" Case Cell = "DE/ASH Logistik/Abris" Case Cell = "DE/EXP Cargo/RRC Cent. Asia" Case Cell = "HU/Trans-Gate/IQ Trading" Case Cell = "USA/Atlanta/Splitpoint" Case "AIRFREIGHT" arrRow = arrRow + 1 KN Case Cell = "China/Shanghai/Splitpoint" Case Cell = "Singapore/KN/CDP" Case Cell = "US/Geodis/Miami" Case Cell = "BR/Sao Paulo/Splitpoint" Case Cell = "Japan / Multitek / Warehouse" End Select Next j1 Next i1 End Sub Private Sub KN() Dim ws As Worksheet Dim KCell, KCellD, KCellW As Range 'Dim j3 As Long Dim D As Date Set wb = ThisWorkbook lRow = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).row lCol = Sheet1.Cells.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column Set ws = wb.ActiveSheet Set rng = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, lCol)) Set KCellD = rng.Find(A(3)) Set KCellW = rng.Find(A(4)) With ws ' ****** Getting an error here , you are not setting KCell Range ****** D = .Cells(i1, KCell.Column) Select Case D Case DateAdd("d", 1, Date) If .Cells(i1, KCellW.Column).Value >= 50 Then For j2 = 1 To UBound(A, 1) arrData(arrRow, j2) = .Cells(i1, j2).Value Next j2 End If Case DateAdd("d", 2, Date) If .Cells(i1, KCellW.Column).Value >= 1000 Then For j2 = 1 To UBound(A, 1) arrData(arrRow, j2) = .Cells(i1, j2).Value Next j2 End If Case Else ' not sure why need, you are not using it End Select End With End Sub

بارك الله فيكم جميعاً وشكراً جزيلا لحضرتك دكتور محمد طاهر وأتمنى لكم النجاح والتفوق دائماً

السلام عليكم استاذى الكريم .. الدكتور محمد طاهر , أرجو توضيح المشكلة التى تحدث معى عند كتابة اسم المستخدم لمحاولة الدخول للمنتدى .فلا استطيع الدخول نهائياً الا بعد كتابة الإميل وليس اسم المستخدم أرجو من سيادتكم التكرم على حل هذه المشكلة ولكم جزيل الشكر

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

وعليكم السلام ... والله نبهنا كثير جداً على عدم رفع أى مشاركة جديدة الا بعد استخدام خاصية البحث بالمنتدى والتأكد يقيناً من خلو المنتدى من طلبك نهائياً ولكن طلبك تكرر من قبل ترحيل واستدعاء بيانات فاتورة

وعليكم السلام ... ارفع من فضلك ملف موضح به ما تريد !!!!

وعليكم السلام-تفضل How To Print Sheet Name Or A List Of Sheet Names In Excel?

طالما انك لم تقم برفع ملف ... فكان عليك استخدام خاصية البحث بالمنتدى -تفضل هل يمكن تفعيل عجلة الماوس داخل الفريم وهذا كود أخر يمكنك استخدامه أكواد اليوزرفورم Option Explicit Private Sub UserForm_Activate() WheelHook Me 'For scrolling support End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) WheelUnHook 'For scrolling support End Sub Private Sub UserForm_Deactivate() WheelUnHook 'For scrolling support End Sub Public Sub MouseWheel(ByVal Rotation As Long) If Rotation > 0 Then 'Scroll up If ListBox1.TopIndex > 0 Then If ListBox1.TopIndex > 3 Then ListBox1.TopIndex = ListBox1.TopIndex - 3 Else ListBox1.TopIndex = 0 End If End If Else 'Scroll down ListBox1.TopIndex = ListBox1.TopIndex + 3 End If End Sub ووضع هذا الكود فى مديول عادى 'https://www.mrexcel.com/board/threads/listbox-mouse-scroll.459781/ Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long Private Const GWL_WNDPROC = -4 Private Const WM_MOUSEWHEEL = &H20A Dim LocalHwnd As Long Dim LocalPrevWndProc As Long Dim myForm As UserForm Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 'To handle mouse events Dim MouseKeys As Long Dim Rotation As Long If Lmsg = WM_MOUSEWHEEL Then MouseKeys = wParam And 65535 Rotation = wParam / 65536 'My Form s MouseWheel function UserForm1.MouseWheel Rotation End If WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam) End Function

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

وعليكم السلام أستاذنا الكريم وكل عام وانتم بخير وعيد سعيد عليكم جميعا -يمكنك تجربة الخطوات الموجودة بهذا الرابط ازالة فيروس الفدية في 9 خطوات وفك تشفير الملفات بدون فورمات

وعليكم السلام-هل هذا ما تريد ؟ 1نموذج.xlsx

كل عام وانتم جميعاً بخير والنجاح والتفوق دائماً لمنتدانا الكريم

وعليكم السلام-تفضل حسابات بنكية1.xlsx

تفضل كان عليك استخدام خاصية البحث بالمنتدى تجنباً لإهدار الوقت خصوصاً ان طلبك تكرر كثير جداً بالمنتدى أو بكل بساطة يمكنك استخدام هذه المعادلة لتلبية طلبك وحله =DATE(IF(LEFT(A3,1)*1=3,20,19)&MID(A3,2,2),MID(A3,4,2),MID(A3,6,2)) (مميز ) دالة استخراج تاريخ الميلاد او النوع او المحافظة من الرقم القومي Text1.xlsm

بالتأكيد كل الطرق متاحة وفعالة فى تلبية طلبك ... وانا استخدمت الطريقة الأولى فى الملف المرفق لك سابقاً وتغيير الإمتداد أمر اختيارى لك ليس له اى ارتباط بهذه الطريقة ولك الحرية فى التغيير من عدمه وشكراَ

بالتأكيد الطرق المذكورة فى فيديو الأستاذ سليم ممتازة وأدت الغرض وشوف بنفسك , الملف بعد التعديل بإحدى الطرق Dispatch Tool.xlsb