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

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

وعليكم السلام كل حاجة تمام التمام المعادلة شغالة في K2 , K3 الخلل موجود في الصفحة main في الخلية E2 لا يوجد تاريخ ادخل على الصفحة والخلية واكتب اي تاريخ ستجد كل شيء تمام التمام تحياتي

ما شاء الله تبارك الرحمن .. متابع الله يعطيك العافيه

ما شاء الله ... ما شاء الله .. 🙂 هذا الأكسس لا تنقضي عجائبه ولا تنقطع فرائده .. 😅🌹 ننتظر الإبداعات عم فادي .. 😊👌

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

ادن جرب الملف المرفق في المشاركة السابقة بعد التعديل '========= استبدل هدا '============== b = Left(j, Len(j) - Len(CStr(Val(j)))) Cnt = Val(Right(j, Len(j) - Len(b))) newCode = b & Cnt + 1 '====== بالكود التالي '========== Dim tmp As String, textPart As String For i = Len(j) To 1 Step -1 If IsNumeric(Mid(j, i, 1)) Then tmp = Mid(j, i, 1) & tmp Else textPart = Left(j, i) Exit For End If Next i

كود برمجي لارسال رساله عبر الواتس اب من الاكسيل الحل المثالي لارسال اكبر عدد من الرسائل من الاكسيل للواتس اب الجديد الكود البرمجي كامل : Sub sendMessage() Dim contact As String Dim text As String num = Application.WorksheetFunction.CountA(Sheets("data").Range("a:a")) - 2 ActiveWorkbook.FollowHyperlink Address:="https://web.whatsapp.com/" Application.Wait (Now + TimeValue("00:00:07")) For I = 0 To num contact = Sheets("data").Range("c2").Offset(I, 0).Value text = Sheets("data").Range("g2").Offset(I, 0).Value Call SendKeys("^%{/}", True) Application.Wait (Now + TimeValue("00:00:05")) Call SendKeys(contact, True) Application.Wait (Now + TimeValue("00:00:05")) Call SendKeys("~", True) Application.Wait (Now + TimeValue("00:00:05")) Call SendKeys(text, True) Application.Wait (Now + TimeValue("00:00:01")) Call SendKeys("~", True) Application.Wait (Now + TimeValue("00:00:01")) Call SendKeys("^%{/}", True) Next I End Sub إرسال رسائل واتساب من إكسل: تُستخدم هذه العبارة بشكل عام للبحث عن طرق إرسال رسائل واتساب من خلال ملف إكسل. ربط إكسل بواتساب: تُشير هذه العبارة إلى البحث عن حلول لربط ملف إكسل بتطبيق واتساب لتمكين إرسال الرسائل تلقائيًا. ماكرو إكسل لإرسال رسائل واتساب: تُستخدم هذه العبارة للبحث عن أكواد ماكرو مخصصة لإكسل تسمح بإرسال رسائل واتساب. أدوات إرسال رسائل واتساب من إكسل: تُشير هذه العبارة إلى البحث عن برامج أو تطبيقات خارجية تعمل كوسيلة وسيطة لإرسال الرسائل من إكسل إلى واتساب. إرسال رسائل واتساب تلقائيًا من إكسل ربط إكسل بواتساب إرسال رسائل واتساب من إكسل . أتمتة واتساب باستخدام إكسل . VBA لربط إكسل بواتساب . ماكرو إكسل لواتساب . وهذا ملف اخر عدلة كما تريد اسهل طريقة ارسال وربط ملف الاكسيل بالواتس اب وارسال رسائل المدرسة او الشركة من الاكسيل للواتس اب.xlsm

أخي @fuadco اذا كان هذا طلبك اضغط على افضل اجابة .ووافني بالرد .

Sub TransferData2() Dim i As Long, Cnt As Long Dim ws As Worksheet, f As Worksheet, sWS As Worksheet Dim Sh As String, arr As Variant Dim tbl As ListObject, a As Range, lige As Range Dim j As String, newCode As String, b As String Set ws = ThisWorkbook.Sheets("تسجيل") Sh = ws.[G3].Value arr = Array(ws.[G4], ws.[G5], ws.[G6], ws.[G7]) For i = 0 To 3 If arr(i) = "" Then MsgBox "يرجى إدخال: " & arr(i).Offset(0, -1), vbExclamation, "إنتباه" ws.Activate: arr(i).Select Exit Sub End If Next On Error Resume Next Set f = ThisWorkbook.Sheets(Sh) On Error GoTo 0 If f Is Nothing Then MsgBox "قائمة المخزون " & Sh & " غير موجودة", vbExclamation Exit Sub End If If MsgBox("هل ترغب في ترحيل بيانات التسجيل؟", vbYesNo + vbQuestion, "تأكيد الترحيل") = vbNo Then Exit Sub Set tbl = f.ListObjects(1) On Error Resume Next Set lige = tbl.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeConstants).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) On Error GoTo 0 ' الكود الجديد If Not lige Is Nothing Then j = lige.Value '========= استبدل هدا '============== ' b = Left(j, Len(j) - Len(CStr(Val(j)))) ' Cnt = Val(Right(j, Len(j) - Len(b))) ' newCode = b & Cnt + 1 '====== بالكود التالي '========== Dim tmp As String, textPart As String For i = Len(j) To 1 Step -1 If IsNumeric(Mid(j, i, 1)) Then tmp = Mid(j, i, 1) & tmp Else textPart = Left(j, i) Exit For End If Next i If tmp <> "" Then Cnt = CLng(tmp) Else Cnt = 0 End If newCode = textPart & (Cnt + 1) Else newCode = ws.[G4].Value End If If Not lige Is Nothing Then Set a = lige.Offset(1, 0) Else Set a = tbl.ListColumns(2).DataBodyRange.Cells(1, 1) If a.Value <> "" Then Set a = tbl.ListColumns(2).DataBodyRange.Cells(tbl.ListRows.Count + 1, 1) End If End If a.Value = newCode ' الكود a.Offset(0, 5).Value = 1 ' الكمية a.Offset(0, 2).Value = arr(1) ' الاسم a.Offset(0, 3).Value = arr(2) ' الوصف a.Offset(0, 7).Value = arr(3) ' الملاحظات a.Offset(0, 9).Value = Format(Date, "dd/mmmm") ' التاريخ Set sWS = Sheets("المشتريات") Set tbl = sWS.ListObjects(1) On Error Resume Next Set lige = tbl.ListColumns(3).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) On Error GoTo 0 If Not lige Is Nothing Then Set a = lige.Offset(1, 0) Else Set a = tbl.ListColumns(3).DataBodyRange.Cells(1, 1) If a.Value <> "" Then Set a = tbl.ListColumns(3).DataBodyRange.Cells(tbl.ListRows.Count + 1, 1) End If End If a.Cells(1, 1).Offset(0, -1).Value = Format(Date, "dd/mmmm") ' التاريخ a.Value = newCode ' الكود a.Offset(0, 5).Value = 1 ' الكمية a.Offset(0, 2).Value = arr(1) ' الاسم a.Offset(0, 3).Value = arr(2) ' الوصف a.Offset(0, 7).Value = arr(3) ' الملاحظات a.Offset(0, 9).Value = Format(Date, "dd/mmmm") ' التاريخ End Sub مبيعات ومشتريات V3.xlsb

جزاكم الله خيرا

=============================================( صور + مرفق + فيديو ) Update: 🌹 اهلا اهلا بالاستاذه @Lamyaa❤️🌹🌹☕ الاداة الي رفعتها مضمنها فيجوال 6 ما تشتغل لبعض الاجهزة لاختلاف 64 وفقر في تعريفات Dell ! ============================================= اهلا بالاستاذ @Moosak 🌹❤️ تقديم نوعين والاثنين من غير اضافة مكتبات خارجية 1- استخدام اداة اكتفتي (TabStrip) من غير اضافة اداة 2- تعديل بالوقت = اسرع بحفظ التغيرات للنص العامودي ================================== وفي الثالثه من تنزيل Ms Word Use IMGE on Ms Aceess من اكواد ودوال الورد تعمل داخل الاكسس تابع الفيديو للتوضيح اسفل الموضوع + تحميل المرفق ☕ =============================================( مرفق + فيديو ) No Add For Active_X-TabspChange_Text_Up_To_Dawon_V1.rar

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

بطريقة سهلة ممكن تفتح ملف باوربوينت فاضي وتكتب النص اللي تريده وتدوره بالطريقة اللي تعجبك وبالتنسيقات اللي تعجبك .. وبعدين نسخ - لصق على التقرير أو النموذج في الأكسس : 🙂 >>>>> (النتيجة)>>>>

مرفق المثال مرة أخرى كمرجع لحالات مستقبلية مشابهة لمن يحتاجها Periods_02.xlsx

حسب فهمي للمطلوب رغم عدم دقة هذه الطريقة في حساب الفرق بين تاريخين لأنها لا تراعي الشهور ذات الأيام 31 أو 28 أو 29 على العموم يمكنك استعمال هذه المعادلة في G4 للحصول على عدد الأيام =IF(DAY(E4)<DAY(D4),30,0)+DAY(E4)-DAY(D4) وهذه في F4 للحصول على عدد الشهور =IF((IF(DAY(E4)<DAY(D4),-1,0)+MONTH(E4))<MONTH(D4),12,0)+IF(DAY(E4)<DAY(D4),-1,0)+MONTH(E4)-MONTH(D4) وهذه للحصول على عدد السنوات =IF((MONTH(E4)-MONTH(D4))<(IF((IF(DAY(E4)<DAY(D4),-1,0)+MONTH(E4))<MONTH(D4),12,0)+IF(DAY(E4)<DAY(D4),-1,0)+MONTH(E4)-MONTH(D4)),-1,0)+YEAR(E4)-YEAR(D4) طبعا يرجع طول المعادلة إلى عدم اعتمادها على نتائج الأعمدة الأخرى (اليوم والشهر) بالتوفيق