محمد الزريعي

لقد قمت بعمل رابط تشعبي داخل احدى خلايا ملف اكسل ،، لمجلد مو جود في القرص D في جهازي ،، ثم قمت بعمل مشاركة للملف ، ------------------------------------------------------------------------------------------------------ الكود شغال معي تمام عندما اكون على جهازي حيث اذا نقرت على الخلية التي موجود فيها الكود ينقلني الرابط الي المجلد الموجود في القرص D وعندما اكون على جهاز اخر في الشبكة ، ثم افتح الملف الذي عملت له مشاركة ،، الكود لا يعمل ،، ؟ ---------------------------------------------------------------------------------------------------------- اريد الطريقه الصحيحة للتعامل مع هذا الكود ، او أي كود ، بحيث اذا نقرت على الرابط ، سواء كنت على جهازي ، او أي جهاز أخر في الشبكة ،، ينقلي الرابط الي المجلد الموجود في جهازي ،

اول شئ اشكرك استاذي القدير ياسر خليل ابو البراء . ثاني شئ طبقت الكود الخاص بك وأشتغل وراح اطبقه على ملفي الخاص الاكسل ، ربما تكون المشكلة لانني قمت بتعريف det1 و det2 نوع تاريخ .. على الشكل التالي dim det1 as date dim det2 as date وعندما مسحتهم اشتغل تمام ،، ولكن فوق هذا نسخت الكود الخاص بك ،، لا نه اضمن .. شكراً على حلك السريع .. وربنا يجعلها في ميزان حسانتك أخي الكريم ..

والله يا استاذي ياسر خليل ابو البراء ،، مش عارف وين المشكلة .. لخصت الكود في كود بسيط للتجربة في المرفق // كود عبارة عن ثلاثة اسطر تقريباً في المديول وليس الفورم . ... عالعموم انا اول ما افتح الملف انقر فوق الدائرة الزرقاء لتشغيل الكود أدخل حرف a النتيجة تظهر عندي صفر sumifsvba.rar شكل الزهايمر أشتغل عند جهازي ما يعرف يجمع ..

S = Application.WorksheetFunction.SumIfs( shName.Range("b3:b" & LRSH), shName.Range("p3:p" & LRSH), (">=" & det1), shName.Range("p3:p" & LRSH), ( ("<=" & det2 ) , shName.Range("o3:o" & LRSH), stafe هذا كود الجمع ،، لكن يطلع عندي خطاء عندما اغير date1 الي dete2

Private Sub CommandButton2_Click() 'On Error Resume Next Dim shet, shName, Activshet, SPF As Worksheet Dim det1, det2, OnDet, OfDet As Date Dim stafe, MyFile, NewName As String nm = ActiveSheet.Name Set Activshet = Sheets(nm) mgm = TextBox2.Text If mgm = "" Then mgm = Date If Not IsDate(mgm) Then MsgBox "mmmmmmmmmmmmmmmmmmmm" TextBox2.Text = "" Else If mgm > 1 Then TextBox2.Text = Format$(mgm, "dd/mm/yyyy") End If sn = 0 det1 = Trim(TextBox1.Text) det2 = Trim(TextBox2.Text) Set shet = Sheets("h") shet.Activate LR = (shet.Cells(Rows.Count, 28).End(3).Row) Set SPF = Sheets("SPerformance") SPF.Range("a4:zz10000").EntireRow.Delete resala1 = "startdate " resala2 = " endate " SPF.Range("c" & 1) = resala1 & det1 & resala2 & det2 For i = 2 To LR stafe = shet.Cells(i, 28) TARGT = shet.Cells(i, 29) OnDet = CDate(shet.Cells(i, 30)) tar = shet.Cells(i, 31) If tar = "" Then tar = Date OfDet = CDate(Format$(tar, "dd/mm/yyyy")) QS = 0 QR = 0 If OfDet >= det1 Or (OfDet = Date And OnDet <= det2) Then sn = sn + 1 LO = (SPF.Cells(Rows.Count, 1).End(3).Row) + 1 SPF.Range("A" & LO) = sn SPF.Range("B" & LO) = stafe for z = 1 to 3 shiit = Sheets(Z).Name Select Case shiit Case Is = ("1") zez = 16 Set shName = Sheets("1") Case Is = ("2") zez = 16 Set shName = Sheets("2") Case Is = ("3") zez = 20 Set shName = Sheets("3") End Select shName.Activate LRSH = shName .Cells(Rows.Count, 4).End(xlUp).Row s = Application.WorksheetFunction.SumIfs((shName .Range("b3:b" & LRSH )), (shName .Range("o3:o" & LRSH )), stafe , (shName .Range("p3:p" & LRSH )), (">=" & det1), (shName .Range("p3:p" & LRSH )), ("<=" & det2)) QS = QS + s QR = QR + R SPF.Range("C" & LO) = 0 SPF.Range("D" & LO) = QS SPF.Range("E" & LO) = 0 SPF.Range("F" & LO) = QR Next z SPF.Activate End If Next i Activshet.Activate End Sub المطلوب هو جمع مبيعات موظف ،، أذا تم تغيير اسم الموظف يقوم بجمع مبيعاته من الشيت رقم 1 ثم الشيت رقم 2 ثم الشيت رقم 3 ،، بين تاريخين محددين ( det1 و det2 )

هذا هو نموذج من الملف sumifsvba.rar هذا هو نموذج من الملف ههههههههههههههههه الكلام يتكرر لوحدة في الموقع

السلام عليكم ورحمة الله وبركاته وبعد لقد وقفت عند الكود التالي من البارحة : Dim state As String Dim shName As Worksheet Set shName = Sheets("mm") LR = shName.Cells(Rows.Count, 4).End(xlUp).Row det1 = CDate("01/01/2016") ' det2 = Date stafe = "amjad" Sai = Application.WorksheetFunction.SumIfs(shName.Range("b3:b" & LR), shName.Range("o3:o" & LR), stafe, shName.Range("p3:p" & LR), (">=" & det1), (shName.Range("p3:p" & LR)), ("<=" & det2)) ممكن احد يساعدني في معرفة وين الخطاء .. المطلوب من الكود جمع مبيعات موظف " amjad" خلال الفترة من تاريخ det1 وحتى تاريخ det2 علماً ان 1- العمود Range("b3:b" & LR) هو ما سيتم جمعة في الشيت 2- العمود Range("o3:o" & LR) هو عمود فية اسماء الموظفين في الشيت 3- العمود Range("p3:p" & LR) هو عمود تاريخ المبيعات في الشيت 4- det1 = بداية التاريخ 5- det2 = نهاية التاريخ اتمنى الحل

الحل هو كالتالي مع مراعاه المسار للملف قم بتعريف المتغيرات Dim OldFolderName As String, NewFolderName As String ثم قم بتعريف الملفات مع مراعاة الامتداد OldFolderName = "C:\Sid1" NewFolderName = "C:\Sid2" ثم قم بتغيير الاسماء بينهم Name OldFolderName As NewFolderName

انا مبتداء في الاكسل ،، واستخدم نفس الطريقة ،، وأضع vba أخر الكلمة البحث وهذا عندما ابحث في المواقع الانجليزية ،، ولكن عندما استفسر عن كود في موقع اوفسنا .. اكتب في العنوان .. كود ( .........طلبي............... ) . باللغة العربية .. وهذا يسهل على الاخرين الذين يبحثون على الاكواد بالغة العربية .. راح يجد الكود الذي يبحث علية .. على سبيل مثال اليوم طرحت سؤال هو أنني اريد كود تغيير اسم المجلد .. كتبت ( كود تغيير اسم المجلد vba ) >> اذا تم حل هذا السؤال اليوم .. غداً من سيبحث علية في جوجل .. سوف يجده في مقدمة البحث .

الاخوة الافاضل .. السلام عليكم ورحمة الله وبركاته وبعد .. لو تكرمتم ،، اريد كود تغيير اسم المجلد ..

حاولت فية لين مشى معي الحين ،، ما بعرف اذا بعدين بيتغير ولا .. لا ... اتفضلو هذا الكود الذي استخدمته Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean) m = TextBox4.Text If m = "" Then GoTo 0 If Not IsDate(m) Then MsgBox "----------------------" TextBox4.Text = "" Else If m > 1 Then TextBox4.Text = Format$(m, "dd/mm/yyyy") End If 0: End Sub --------------------- ثم اضفت عند النقر على الزر كلمة dat1 = CDate(TextBox4.Text)

لقد سيوت هذا الكود وما نفع معي Private Sub Text4_LostFocus() m = TextBox4.Text If m = "" Then GoTo 0 If Not IsDate(m) Then MsgBox "يرجى ادخال التاريخ بشكل صحيح" TextBox4.Text = "" Else If m > 1 Then TextBox4.Text = Format$(m, "dd/mm/yyyy") End If 0: End Sub

الاخوة الاعزاء .. عندي فورم فيها أربعة تكست بوكس .. و واحد مفتاح CommandButton1 ------ طبعاً في التكست بوكس 1 // الاسم في التكست بوكس 2 / التاريخ اريد الحدث ينطلق بعدما أنتقل من التكست بوكس 2 اي بعدما اتركها .. وانقر على اي شئ خارج الفورم . ،، والحدث وظيفته هو يقوم بتنسيق التاريخ من (1/1/2016 ) الي ( 01/01/2016 ) .. هذا الهدف منه . فقط

مشكورين وما قصرتم معي .. الف الف شكر لكم جميعاً اساتذتي الكرام ،، الله يجعها في ميزان حسناتكم .

"محمد" = SNem LR = .Range("a" & Rows.Count).End(xlUp).Row + 1 (x = Application.WorksheetFunction.CountIf(Shet.Range("b4:b" & LR ), SNem If x >= 1 Then M = x.adress endif في الكود السابق / الخطاء هو للون الاحمر .. وهو المطلوب من الكود هو يبحث في الرنج b4:b عن أسم ( محمد ) إذا كانت موجودة يعطيني رقم الصف الذي يوجد به ( محمد)

مساء الخير اخواني الاعزاء .. في المرفق : مطلوب ترحيل حسب التاريخ بشرط عدم تكرار الاسماء للموظفين . والشرط الثاني يجمع مبيعات الموظف الكاش والاجل في نفس الصف ، في الشيت الثاني .. اقصد أذا ضغط على الزر يطلب من ادخال الفترة ( خلال الفترة من تاريخ الي تاريخ ) أذا أدخلت التاريخ ،، يقوم بترحيل مبيعات الموظفين للشيت الثاني خلال هذه الفترة فقط ، مع عدد العمليات .. ترحيل.rar

لقد بحث عن كود التحقق من أن الملف موجود في المجلد او لا وهو كالتالي : 1- يشوف أذا كان الملف الموجود في مجلد NEW FOLDER ومطابق للأسم FNAME وامتداه XLSX موجود أو لا MyFlName = Dir("D:\New folder\" & fname & ".xlsx") 2- أذا كان فاضي يعني غير موجود ، فإنة يقوم بإنشاء الملف ثم يقوم بتنسيقة وحفظة في المكان المخصص ثم أغلاقه . If MyFlName = "" Then 3- أذا كان موجود فإنه يتابع الكود الذي كتبة الأستاذ مختار . وقمت بتحديد المتغير X لتحديد قيمة التاريخ في WB1 4- ثم بعد فتح WB2 وضعت هذا الكود LR2 = WB2.Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row لتحيد اخر خلية فيه 5- ثم حددت المتغير yy هو ليأخذ التاريخ الثاني . ثم وضعت IF الشرطية اذا تساو X مع Y لا يقوم باللصق . ليعود من جديد . شكراً لكم جميعاً . وحصلت على اكواد التنسيق أيضا كنت ابحث عنها ،، وهي كالتالي : Worksheets(1).Columns("a").ColumnWidth = 2 'Rows("3:25").RowHeight = 25 تحياتي لكم ..

اخي مختار حسين محمود :: اعتذر منك ،، في الكود السابق يرحل حتى وان كان التاريخ متشابة ،، وانا اريدة يرحل اذا كان التاريخ مختلف فقط .. يعني اذا لم يحصل الموظف على ترقية فإن تاريخ اخر ترقية يظل كما هو لم يتعدل ، وأذا حصل على ترقية فإن تاريخ الترقية اكيد راح يختلف مع مرور الزمن ،، وعندما يختلف تاريخ الترقية يرحل البيانات الجديدة ليضيفها الي سجله الخاص به . كما هو في الصورة المرفقة . وأيضاً موجود الشرح في الملف المرسل سابقاً . كما أن أسماء الملفات لابد أن تكون بأسماء الموظفين وليس ارقام التسلسل . حاولت مع هذا الكود التالي لكن مانفع معي طلع غلط .. Set WB1 = ActiveWorkbook 'تشنيط الملف الاول LR1 = ActiveSheet.Cells(Rows.Count, 2).End(3).Row 'عدد صفوف الملف الاول For i = 4 To LR1 fname = Cells(i, "b") Set Wk = Workbooks.Add Application.DisplayAlerts = False Worksheets(1).Cells(1, "a") = "م" Worksheets(1).Cells(1, "b") = "اسم الموظف" Worksheets(1).Cells(1, "c") = "العمر" Worksheets(1).Cells(1, "d") = "الوظيفة السابقة" Worksheets(1).Cells(1, "e") = "الراتب" Worksheets(1).Cells(1, "f") = "تاريخ التوظيف" Worksheets(1).Cells(1, "g") = "تاريخ الترقية " Worksheets(1).Cells(1, "h") = "الوظيفة الحالية" Worksheets(1).Cells(1, "i") = "ملاحظات " Wk.SaveAs Filename:="D:\New folder\" & fname & ".xlsx" Workbooks(fname & ".xlsx").Close SaveChanges:=False

نعم هذا الكود المطلوب وجزاك الله خير الجزاء اخي مختار ما قصرت ،، الله يجعلها في ميزان حسناتك . وأشكر استاذي القدير ياسر أبو البراء ،، من زمان وأنت واقف معانا ،، الله يعينك ،، اخي ياسر .. ------------------------------------------------------------------------------------------------------------

صباح الخير شباب ،، عندي هذا الملف ،، اريد ان ارحل منه الي ملفات اكسل الخاصة بالموظفين والمتابعة شبه يومي . حيث أن ملف الموظفين موجود في القرص d بقية الشرح موجود في داخل الملف اكسل ترحيل بيانات من ملف الي ملف اخر مغلق.rar

لقد قام الأستاذ القدير / ياسر خليل بحل المشكلة التي ظهرت معنا في هذا الرابط التالي :

الأخ الكريم ياسر خليل .. الحل جميل جداً ،، اعمالك بصراحة ممتازة .. ( تجيبها يمين تجيبها يسار تضبط ) والمميز فيك أنك تقدم المعلومة بكل بساطة ومختصرة . ( انت مالكش حل ) ماشاء الله عليك .. اشكرك جزيل الشكر .. على ما تقدمة من خير في هذا الموقع ، وباذن الله تجد الخير امامك أينما اتجهت ..

إبداعاتك أبو عيد جعل ايامك كلها أعياد .. وعمل ممتاز وهذه الأرقام السرية للمستخدمين لمن يريدها بكل بساطة . إسم المستخدم الباسود ADMIN 3333 USER 1 1234 USER 2 12345 محسن 4444 مهند 5555 أبوعيد 6666

اسف اخي الكريم / ياسر .. انا نسيت ما اعطيك كلمة المرور للحماية للورقة H راحت من بالي والرقم السري هو 120 انا نسخت وضع المعاملة كما هو من الورقة h الي ورقة التمويل ..

اخي العزيز ياسر خليل .. تم تجربة الكود الجديد ،، فوجته يقوم بترتيب عمود البنك فقط ،، ويتجاهل عمود وضع المعاملة .. ويتجاهل عمود المدة ---------------------------------------------- أين أجد المسافة الزائدة ،، هل هي المسافة بين الأعمدة أو تقصد المسافة التي توجد في اكلمات . أذا كانت المسافة بالكلمات فأنا اخذت نسخة من وضع المعاملة الي التمويل و لم أضيف شيء جديد . -----------------------------------------------