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

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

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

السلام عليكم ورحمة الله تعالى وبركاته جرب هدا =IFERROR(INDEX(اجمالي6!$A$4:$A$600;AGGREGATE(15;6;ROW(اجمالي6!$A$1:$A$600)/(اجمالي6!$AH$4:$AH$600="ذكر")/(اجمالي6!$AE$4:$AE$600="ناجح ومنقول للصف الأول الاعدادي");ROW(اجمالي6!A1));1);"") TEST.xlsx

شكرا جزيلا لكما وبارك الله فيكما وجعله في ميزان حسناتكما

تفضلي ، نستعمل Parent للاشارة الى النموذج الرئيسي DoCmd.OpenForm "URINE", , , "[ID]=" & Me.Parent!ID Forms!urine!ID = Me.Parent!ID Forms!urine!code = Me.Parent!code Forms!urine!T.date = Me.Parent!T.date

يسعدنا اننا استطعنا مساعدتك ادن اليك حل اخر في حالة عدم الرغبة باستخدام المعادلات Sub ExtractFromText2() Dim arr() As String, Cell As Range, i As Integer, lr& Set WS = Sheets("ATIF") Application.ScreenUpdating = False WS.Range("b2:C" & WS.Rows.Count).ClearContents lr = WS.Cells(Rows.Count, "A").End(xlUp).Row For Each Cell In Range("A2:A" & lr) arr = Split(Trim(Cell), "-") If UBound(arr) <> 0 Then For i = 0 To UBound(arr) Cell.Offset(, i + 1) = arr(i) Next End If Next Application.ScreenUpdating = True End Sub '*********OR*********** Sub ExtractFromText3() Dim r As Range, lr& Set WS = Sheets("ATIF") Application.ScreenUpdating = False With WS .Range("B2:C" & .Rows.Count).ClearContents lr = .Cells(Rows.Count, "A").End(xlUp).Row For Each r In Range("A2:A" & lr) .Range(r.Offset(0, 1), r.Offset(0, 2)).Value = Split(r, "-") Next r End With Application.ScreenUpdating = True End Sub

وعليكم السلام ورحمة الله تعالى وبركاته هل هدا ما تقصده Sub Macro1() Msg = MsgBox("تفريغ البيانات ؟", vbYesNo, "تأكيد") If Msg <> vbYes Then Exit Sub Application.ScreenUpdating = False [D5:K18].ClearContents Application.ScreenUpdating = True End Sub

بما انني غير متاكد من مكان وضع النتائج اليك اسهل طريقة لتتمكن من تعديلها على حسب احتياجاتك Sub ExtractFromText() Dim lr& Set ws = Sheets("ATIF") Application.ScreenUpdating = False ws.Range("b2:c" & ws.Rows.Count).ClearContents lr = ws.Cells(Rows.Count, "A").End(xlUp).Row With ws.Range("B2:B" & lr) .Formula = "=LEFT(A2,FIND(""-"",A2)-1)" .Value = .Value With ws.Range("C2:C" & lr) .Formula = "=MID(A2,FIND(""-"",A2)+1,LEN(A2))" .Value = .Value End With End With Application.ScreenUpdating = True End Sub

وعليكم السلام 🙂 لفتح نموذج اسمه URINE ، ونقل بيانات الحقول ID,CODE, T.date اليه DoCmd.OpenForm "URINE", , , "[ID]=" & Me.ID Forms!urine!ID = Me.ID Forms!urine!code = Me.code Forms!urine!T.date = Me.T.date جعفر

ادن يمكنك استخدام الصيغ على النحو التالي ' الوصف =LEFT(A2,SEARCH("-",A2)-1) 'or =LEFT(A2,FIND("-",A2)-1) 'الكود =MID(A2,FIND("-",A2)+1,LEN(A2)) 'or =RIGHT(A2,LEN(A2)-SEARCH("-",A2)) 'or =MID(A2,FIND("-",A2)+1,100) مع سحب المعادلة للاسفل atf v2.xlsb

هل هده هي النتيجة المتوقعة

وعليكم السلام ورحمة الله وبركاته **كود VBA لفصل محتوى الخلية إلى جزئين (الوصف والكود):** Sub SplitCellContent() Dim rng As Range Dim arrContent() As String Dim strDescription As String Dim strCode As String ' تحديد الخلية التي تحتوي على المحتوى الذي تريد فصله Set rng = Range("A2") ' تقسيم المحتوى إلى مصفوفة من السلاسل arrContent = Split(rng.Value, " ") ' استخراج الوصف والكود من المصفوفة strDescription = arrContent(0) strCode = arrContent(1) ' وضع الوصف والكود في خلايا منفصلة rng.Offset(0, 1).Value = strDescription rng.Offset(0, 2).Value = strCode End Sub **مثال:** إذا كان محتوى الخلية A2 هو: جهاز كمبيوتر محمول HP EliteBook 840 G8 فسيؤدي تشغيل كود VBA هذا إلى فصل المحتوى إلى الخليتين B2 وC2 على النحو التالي: * **B2:** جهاز كمبيوتر محمول HP EliteBook 840 G8 * **C2:** 840 G8 **ملاحظة:** * يمكنك تعديل كود VBA لتناسب احتياجاتك الخاصة، مثل تغيير الخلية التي تحتوي على المحتوى أو تغيير الفاصل المستخدم لفصل الوصف والكود. * يمكنك أيضًا استخدام كود VBA لفصل محتوى الخلية إلى أكثر من جزئين.

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

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

ابدعت استاذي @Moosak نفعكم الله

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

الخبير الفاضل المبدع خالص الشكر ربنا يكرمك ويعزك خالص الشكر

كود VBA لحذف الشيتات المخفية في ملف Excel عند محاولة فتحها في الجوال وعدم حذفها عند فتحها في اللابتوب: Private Sub Workbook_Open() Dim ws As Worksheet Dim deleteHiddenSheets As Boolean Dim operatingSystem As String operatingSystem = Application.OperatingSystem If operatingSystem Like "*phone*" Then deleteHiddenSheets = True Else deleteHiddenSheets = False End If If deleteHiddenSheets Then Application.DisplayAlerts = False For Each ws In ThisWorkbook.Sheets If ws.Visible = xlSheetHidden Then ws.Delete End If Next ws Application.DisplayAlerts = True End If End Sub يقوم هذه الكود بفحص نوع نظام التشغيل وفي حال كان النظام هو هاتف (جوال)، سيتم حذف جميع الشيتات المخفية. وإذا كان النظام ليس هاتف (مثل اللابتوب)، لن يتم حذف الشييتات المخفية. يمكنك استخدام هذا الكود في ملف Excel الخاص بك لتحقيق ذلك.

صراحة لم استوعب الفكرة جيدا حاول تجربة هدا يدويا وتعديله بما يناسبك Sub InsertHyperlinks() Dim a As Range, b As Range Dim rCnt As Worksheet, xCnt As Worksheet Dim WS As Worksheet, dest As Worksheet Set WS = Sheet1: Set dest = Sheet2 On Error Resume Next WS.Activate Set a = Application.InputBox("الرجاء تحديد الخلية الأولى التي تحتوي على الارتباط التشعبي" & vbCrLf & vbCrLf & _ "NOTE: يمكن إضافة الارتباطات التشعبية فقط على النص وليس على الخلايا التي تحتوي على صيغ!" & "تحديد الارتباط التشعبي 1", Type:=8) Set rCnt = a.Worksheet dest.Activate Set b = Application.InputBox("الرجاء تحديد الخلية الثانية التي تحتوي على ارتباط تشعبي" & "تحديد الارتباط التشعبي 2", Type:=8) Set xCnt = b.Worksheet WS.Hyperlinks.Add Anchor:=a, Address:="", SubAddress:= _ "'" & xCnt.Name & "'" & "!" & b.Address, TextToDisplay:=CStr(b.Value) dest.Hyperlinks.Add Anchor:=b, Address:="", SubAddress:= _ "'" & rCnt.Name & "'" & "!" & a.Address, TextToDisplay:=CStr(b.Value) End Sub

اشوفك بدأت تعرف السر

لديك اخطاء في تحديد اسماء الخلايا كما في الصورة المرفقة تم تعديل الكود ليسهل التعامل معه Private Sub CommandButton2_Click() 'بحث Dim WS As Worksheet, F As Worksheet Dim Irow As Long, Clé As String, i As Long Set WS = Sheets("Sheet2"): Set F = Sheets("Sheet1"): Clé = F.[E3] Application.ScreenUpdating = False If Clé = Empty Then: MsgBox "برجاء إدخال اسم للبحث عن بياناته", vbCritical, "فلاح": Exit Sub Irow = WS.Cells(WS.Rows.Count, "B").End(xlUp).Row Set rng = WS.Range("B3:B" & Irow).Find(Clé, LookIn:=xlValues, _ lookat:=xlWhole, SearchDirection:=xlPrevious) If rng Is Nothing Then: MsgBox " الاسم غير موجود", vbExclamation, Clé: Exit Sub For i = 3 To Irow If WS.Cells(i, 2) = Clé Then ' Colmun (D) F.[D5] = WS.Cells(i, "B") F.[D7] = WS.Cells(i, "C"): F.[D9] = WS.Cells(i, "D"): F.[D11] = WS.Cells(i, "E") F.[D13] = WS.Cells(i, "F"): F.[D15] = WS.Cells(i, "G"): F.[D17] = WS.Cells(i, "H") F.[D19] = WS.Cells(i, "I"): F.[D21] = WS.Cells(i, "J"): F.[D23] = WS.Cells(i, "K") ' Colmun (G) F.[G7] = WS.Cells(i, "L"): F.[G9] = WS.Cells(i, "M"): F.[G11] = WS.Cells(i, "N") F.[G13] = WS.Cells(i, "O"): F.[G15] = WS.Cells(i, "P"): F.[G17] = WS.Cells(i, "Q") F.[G19] = WS.Cells(i, "R"): F.[G21] = WS.Cells(i, "S"): F.[G23] = WS.Cells(i, "T") ' Colmun (J) F.[J7] = WS.Cells(i, "U") F.[J9] = WS.Cells(i, "V"): F.[J11] = WS.Cells(i, "W") F.[J13] = WS.Cells(i, "X"): F.[J15] = WS.Cells(i, "Y") End If Next Application.ScreenUpdating = True End Sub مع تعديل كود الترحيل بالشكل التالي Private Sub CommandButton1_Click() ' اظافة Dim WS As Worksheet: Dim F As Worksheet Set WS = Sheets("Sheet1"): Set F = Sheets("Sheet2") Application.ScreenUpdating = False F.Range("B" & F.Rows.Count).End(xlUp).Offset(1).Resize(, _ 24).Value = Application.Index(WS.Range _ ("D5,D7,D9,D11,D13,D15,D17,D19,D21,D23,G7,G9,G11,G13,G15,G17,G19,G21,G23,J7,J9,J11,J13,J15"), _ 1, 1, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, _ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26)) With F.Range("A3:A" & F.Cells(Rows.Count, "B").End(xlUp).Row) .Value = Evaluate("ROW(" & .Address & ")-2") End With Lr = F.Range("A65500").End(xlUp).Row b = F.Cells(2, F.Columns.Count).End(xlToLeft).Column F.Range(F.Cells(3, 1), F.Cells(Lr, b)).Borders.Weight = xlThin ' افراغ CommandButton4_Click Application.ScreenUpdating = True MsgBox "تم اضافة البيانات بنجاح" End Sub 123 (1).xlsm

أهلا بالجميع.. الحقيقة أن الزملاء قاموا بعمل جبار في تطويع أكسس للإنجاز الفكرة.. بارك الله في الجهود.. تحقيق طريقة HTML مع أكسس أرى أن فيها صعوبة! ولم أجرب فعل ذلك.. لكن استخدام محتوى HTML في أكسس، فذلك ممكن... Pattern_Keypad_ADB.zip