نجوم المشاركات

جرب هذا الشيء Private Sub CommandButton1_Click() Dim LR As Long LR = Cells(Rows.Count, 1).End(xlUp) msgbox ChrW(163) & LR End Sub

تم كذلك المرفق يناسبك تم هذا اصدار 2003 Database2.mdb

لا أدري ما سبب تكرار المواضيع حسب فهمي للمطلوب تم تعديل الكود ليقوم بنفس الترحيل حتى لو أكثر من صف يمكن وضع هذا الكود في مودبول جديد Sub tarheel() lr = Range("a4").End(xlDown).Row Set Sh = Sheets.Add With ActiveSheet .Move after:=Sheets(Sheets.Count) .Name = Sheets.Count - 1 .Range("A1:P12").Borders.Weight = xlMedium .Range("A1:P12").HorizontalAlignment = xlCenter With .Cells(1).Resize(1, 16) .Value = Array("ITEM NUMBER", "ITEM DESC", "QUANTITY", "UNIT PRICE", "TOTAL", "WHSE", "ACOUNT CODE", "BUSINESS UNIT", "DEPARTMENT", "WORK CENTER", "FLOCK", "ÚÏÏ ÇáØÈÇáí", "æÒä ÇáØÈíáÉ ", "ÚÏÏ 0.9", "", "ÚÏÏ 1.34") .Interior.ColorIndex = 53 .Font.Bold = True .Font.Color = vbWhite End With Dim sh1 As Worksheet Set sh1 = Sheets("main") For n = 5 To lr lr2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Range("A" & lr2) = sh1.Range("E" & n).Value .Range("C" & lr2) = sh1.Range("f" & n).Value .Range("D" & lr2) = sh1.Range("E" & n).Value .Range("F" & lr2 & ":K" & lr2).Value = Array("DAT010", "1141000022", "JP-PROD.", "JP-WIPDP", "JP-WIPWC", "Flock_4") .Range("N" & lr2) = sh1.Range("c" & n).Value .Range("P" & lr2) = sh1.Range("a" & n).Value + sh1.Range("b" & n).Value .Columns("A:P").EntireColumn.AutoFit Next n End With End Sub مع حذف الكود في حدث عند تغيير قيم الشيت main مع ربط الزر بالماكرو الجديد tarheel بالتوفيق

بعد إذن أخي الكريم عبد الفتاح ربما يكون هذا هو المطلوب Private Sub CommandButton1_Click() Dim LR As Long LR = Cells(Rows.Count, 1).End(xlUp) MsgBox Format(LR, """S21-""00#") End Sub

مثال الحل سيكمل 24 ساعة وكأنه غطي بطاقية إخفاء ، الله المستعان.

شكرا جزيلا استاذ احمد الله يجعلها في ميزان حسناتك تحياتي لحظرتك

و عليكم السلام و رحمة الله وبركاته Sub Add_One() Dim FR For FR = 10 To 50 Cells(FR, 3) = Val(Cells(FR, 3)) + 1 Next MsgBox "plus 1 add to all" End Sub زائد1.xlsm

او بطريقة اخرى Private Sub Form_Load() X = CurrentProject.Path & "\Setting.ini" If Len(Dir(X)) = 0 Then Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile(CurrentProject.Path & "\Setting.ini", True) a.WriteLine ("1") a.Close Else Open CurrentProject.Path & "\Setting.ini" For Input As #1 Input #1, X Me.L1 = X Close #1 End If End Sub تحياتي

تفضل اخي الكريم Private Sub Form_Load() On Error GoTo err: Dim X As String Open CurrentProject.Path & "\Setting.ini" For Input As #1 Input #1, X Me.L1 = X Close #1 err: Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile(CurrentProject.Path & "\Setting.ini", True) a.WriteLine ("1") a.Close End Sub تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub cmdSave_Click() X1 = CurrentProject.Path & "\Setting.ini" X3 = FreeFile Open X1 For Input As X3 Line Input #X3, X X5 = X5 & X Close X3 If Me.L1 = 1 Then X7 = 2 Else X7 = 1 End If X5 = Replace(X5, X7, Me.L1) X3 = FreeFile Open X1 For Output As X3 Print #X3, X5 Close X3 End Sub Private Sub Form_Load() Dim X As String Open CurrentProject.Path & "\Setting.ini" For Input As #1 Input #1, X Me.L1 = X Close #1 End Sub Project201.rar تحياتي

جرب هذه المعادلات خساب الاقدمية.xls

يمكنك وضع هذه المعادلة في الخلية F3 =INDEX(H:H,MATCH($F$2,D:D,0)) وهذه في الخلية F5 =INDEX(I:I,MATCH($F$2,D:D,0)) وهي تعني البحث في العمود H في الصف الذي يطابق فيه العمود D مع قيمة الخلية F2 بالتوفيق

حسب فهمي للمطلوب تم إضافة عمود فارغ بعد العميل رقم 14 حتى تنتظم معادلات أرقام الأعمدة تم إضافة كود لجلب جميع أسماء العملاء وأرقامهم في العمود A & B تم وضع معادلة للبحث في قائمة العملاء هذه حتى لا نحتاج سوى رقم العميل ويظهر اسمه مباشرة تم وضع كود في حدث تغيير الخلية A2 وكتابة رقم العميل يتم تحديث قائمة العملاء ثم الانتقال إلى الخلية الخاصة باسم العميل بالتوفيق حسابات العملاء الجديد.xlsb

من لا يشكر الناس لا يشكر الله، وأنتم جميعاً تستحقون الشكر والثناء، فلولاكم لم يكن منتدى يصل إلى الأفضل ، ولولا جهودكم لما كان للنجاح أي وصول ولما تحققت الأهداف، فأنتم أساس رفعة هذه المنتدى وأساس تقدُّمه، وأنتم من يحمل شعلة النجاح والتطور، فشكراً لكم وإلى الأمام دائماً. تم تنفيذ المطلوب الاخ العزيز محمد صالح يوجد تكرار على كل ضغط عمليه ترحيل اي عند ضغط على الترحيل يقوم بالترحيل سواء صف أو أكثر تمام ولكن ارجوا ان يكون بدون تكرار الترحيل اي يظهر رساله تم الترحيل مسبقا يعمل فصل بين الصف المرحل أو أكثر من صف عند ادخال اي بيانات جديده على الجدول عند الضغط على الترحيل

لا اعلم ماذا تعني بهذا ثم اجبتك بناء على الصورة .ضع الصورة النهائية للقيمة في الخلية

تم التحويل في المشارركة في الأعلى لكن تفضل هذه مرة اخرى Database2.mdb

للأسف ما يظهر في الوورد هو الأصح لأن تنسيق الأرقام في الإكسل 00 لم يظهر الكسر لذلك يمكنك تعديل معادلة الشهر إلى =INT(I2*7.5/30+MOD(H2*3,12)) بأن تشمل دالة int العملية الحسابية كلها وكذلك تعديل معادلة اليوم إلى =INT(J2*0.25+MOD(I2*7.5,30)) بالتوفيق

وهذا ملف للعمل عيه Report.rar

علشان كده طلبت منك ان ترفع ملف من عندك يتم التطبيق عليه ويسهل علينا ما تريد بسم الله ما شاء الله ابداع بس ممكن اطلب اضافه صغيره لو فرضنا ان هناك مجلد اسمه img مع ملف قاعدة البيانات وان فى جدول الطلبه رقم جلوس 123456 و فى ملف الصور img هناك صورة اسمها 123456.jpg كيف اربط بينهم تلقائي بدون ما كل مره اذهب لوضع مسار الصوره

ارفق ملف مثال عشان تاخذ عليه التعديل او استخدم الكود التالي Dim fso As Object Dim oFSO As Object Dim oFolder As Object Dim oFile As Object Dim i As Integer Dim x As String Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder("مسار المجلد") For Each oFile In oFolder.Files x = x & vbNewLine & oFile.Name Next oFile MsgBox x سيتم عرض اسماء الصور التي في المجلد في صندوق الرسائل لكن لو حبيت ان تحتفظ بمسار الصور داخل قاعدة الببيانات تفضل هذا المثال اختر المجلد ثم تحميل سيتم تحميل كافة اسماء الملفات و اضافة رابط الموقع اليها Report.accdb

بارك الله فيك يا استاذ محمد وفي صحتك وأهلك ومالك وعلمك جزاك الله خيرا

تفضل هذا هو المطلوب بإذن الله معادلة بسيطة جدا يمكنك التوصل إليها ضع في L2 المعادلة التالية ثم اسحب المعادلة لأسفل =J2+K2-SUMIF(A:A,I2,B:B) وتعني جمع الخلية k2 مع J2 مع طرح مجموع المستهلك في نفس التاريخ الموجود في I2 بدالة sumif بالتوفيق

المعادلات المستعملة هي mod & int وهناتجها رقم صحيح بدون علامات عشرية ربما لو أرفقت الملفين الوورد والاكسل المستعملين في دمج المراسلات لعرفنا موضع المشكلة

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

المطلوب الثاني غير متعلق بالموضوع ويمكنك التوصل اليه بالبحث https://www.officena.net/ib/search/?q=إغلاق الاكسل بعد فترة&updated_after=any&sortby=relevancy&search_and_or=and بالتوفيق

هل تقصد إغلاق الاكسل كله إذا لم يكن هناك مصنفات مفتوحة غير هذا المصنف؟

يمكنك استعمال هذا الكود في حدث قبل إغلاق الملف Private Sub Workbook_BeforeClose(Cancel As Boolean) Sheets("Introduction").Range("G10") = "" Sheets("Introduction").Range("G12") = "" ThisWorkbook.Save End Sub وينبغي حفظ الملف بامتداد يسمح بالأكواد مثل xlsb بالتوفيق

لظهور الأقواس مضبوطة ينبغي التأكد من اتجاه المستند من اليمين لليسار وكذلك اتجاه الكتابة (إذا كانت لغة الكتابة عربية) وإذا أردت الاستبدال بعد ذلك فعليك بالآتي : استبدال القوس الأول إلى رمز غريب غير مستعمل في المستند مثل # مع تنفيذ استبدال الكل استبدال القوس الثاني إلى القوس الأول مع تنفيذ استبدال الكل استبدال الرمز الغريب إلى القوس الثاني مع استبدال الكل بالتوفيق

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم كود لعمل فلتر للنموذج الفرعي حسب القسم Private Sub نص96_Change() If Me.نص96 = "جميع المستويات" Then Me.RecordSource = "معلومات التلاميذ" Me.t1.Form.FilterOn = False Else Me.RecordSource = "Query1" myCriteria = myCriteria & "(" myCriteria = myCriteria & "[معلومات التلاميذ].[القسم]= '" & Me.نص96 & "'" myCriteria = myCriteria & ")" Me.t1.Form.Filter = myCriteria Me.t1.Form.FilterOn = True End If Me.Requery End Sub المستخدم - Copie.rar تحياتي

ربما تحتاج بعض الأكواد لتعديل لتناسب نسخة 46 بت بإضافة كلمة ptrsafe قبل كلمة function يفضل إرفاق مثال للتوضيح

تفضل التعديل ارجو ان يكون طلبك حساب تاريخ الحمل-11.rar

السلام عليكم ,كان عليك قبل رفع هذه المشاركة استخدام خاصية البحث فى المنتدى فهناك العديد من الموضوعات التى تخص طلبك ومنها :- كيفية إظهار اسم المستخدم على تكست بوكس بعد الدخول برنامج صلاحيات المستخدمين الاصدار 3 شاشة دخول مع صلاحيات

السلام عليكم ورحمة الله اخى الكريم انظر الى هذا الملف قوائم اللجان.rar