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

يمكنك استعمال هذا الكود بعد فك دمج الخلايا وتغيير الامتداد إلى xlsb حتى يقبل الأكواد Sub repchr() Range("b6,b9").ClearContents For n = 1 To Len([b3]) If UBound(Split([b3], Mid([b3], n, 1))) > 1 Then [b6] = [b6] & IIf(InStr([b6], Mid([b3], n, 1)) = 0 And Mid([b3], n, 1) <> " ", IIf([b6] = "", "", "-") & Mid([b3], n, 1), "") Else [b9] = [b9] & IIf([b9] = "", "", "-") & Mid([b3], n, 1) End If Next n MsgBox "Done by mr-mas.com" End Sub الكود يقوم بوضع الحروف المكررة في الخلية b6 والحروف غير المكررة في الخلية b9 اعتمادا على النص الموجود في الخلية b3 بالتوفيق

ممكن مرفق صغير للتعديل عليه .... لان الشغلة تحتاج عمل واكواد بارك الله فيك

تفضل التعديل ‏‏شؤون الموظفين حساب ساعات المكرر.zip

بعد الانتهاء من اضافة الموظف قم بالضغط على حفظ ....... انظر المرفق ربما هو ما تريد .... dbo_da_kan.accdb

بسبب المعيار الموجود في الاستعلام المرتبط بالتقرير انا لغيت المعيار في الاستعلام في النموذج و جعلت الفلتر بالكامل بالكود طبق نفس الكود على التقرير

تفضل التعديل Qry_test.zip

مش كده بالضبط يابو الحسن الي يصير ان راح تكون فيه قاعدة بيانات بصيغة sql server هذه القاعدة تحل مكان الجداول في الاكسس و تستخدم نفس نفس واجهات الاكسس لكن الجداول تكون في سيرفر خارجي بعيد

ربما يكون هذا مقصودك Private Sub ComboBox1_Change() If Me.ComboBox1 = "مدفوع كبير" Then Me.TextBox1.Enabled = True Me.TextBox2.Enabled = True Me.TextBox3.Enabled = False Me.TextBox4.Enabled = False ElseIf Me.ComboBox1 = "مدفوع صغير" Then Me.TextBox1.Enabled = False Me.TextBox2.Enabled = False Me.TextBox3.Enabled = True Me.TextBox4.Enabled = True End If End Sub بالتوفيق

تفضل استاذ الحلبي تحديث.accdb

Sub Test() Const col As Integer = 3 Dim a, e, dic As Object, k As String, i As Long Application.ScreenUpdating = False Set dic = CreateObject("Scripting.Dictionary") With Sheets(1).Range("A1:AA" & Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row) a = .Columns(col).Resize(, 2).Value For i = 6 To UBound(a, 1) k = a(i, 1) & Space(1) & a(i, 2) If Not dic.Exists(k) Then Set dic(k) = Union(.Rows("1:5"), .Rows(i)) Else Set dic(k) = Union(dic(k), .Rows(i)) End If Next i End With For Each e In dic If Not Evaluate("ISREF('" & e & "'!A1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = e End If With Sheets(e) .DisplayRightToLeft = True .UsedRange.Clear dic(e).Copy .Cells(1) .Columns.AutoFit End With Next e Application.CutCopyMode = False Application.ScreenUpdating = True End Sub Delete the columns from column AB to column AK first then run the code 1تقرير كامل تشغيل.xlsm

ربما يفيدك هذا الموضوع بالتوفيق

اشكرك على هذا الاطراء الجميل اخي تفضل التعديل من 1 الى 5 = صباحية 6 ساعات و هكذا بالإمكان تعديل ساعات العمل من خلال الكود او انشاء جدول لساعات العمل و جلبها من خلال الكود ‏‏شؤون الموظفين حساب ساعات المكرر.zip

اخي الكريم في البداية قم بإنشاء Module جديد و من خلال المكتبات قم بإضافة المكتبة التالية فقد يختلف رقم الإصدار حسب اصدار الأوفيس لديك و في Module الصق الكود التالي Option Explicit Public as1 As String Public Function Translate(strInput As String, strFromSourceLanguage As String, strToTargetLanguage As String) As String Dim strURL As String Dim objHTTP As Object Dim objHTML As Object Dim objDivs As Object, objDiv As Object Dim strTranslated As String strURL = "https://translate.google.com/m?sl=" & strFromSourceLanguage & "&tl=" & strToTargetLanguage & "&q=" & strInput & "&hl=ar" Set objHTML = Nothing Set objHTTP = CreateObject("Msxml2.XMLHTTP.6.0") objHTTP.Open "GET", strURL, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.send "" Set objHTML = CreateObject("htmlfile") With objHTML .Open .Write objHTTP.responseText .Close End With Set objDivs = objHTML.getElementsByTagName("div") For Each objDiv In objDivs If objDiv.className = "result-container" Then strTranslated = objDiv.innerText Translate = strTranslated End If Next objDiv 'DoCmd.GoToRecord , , acNext End Function Function EncodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String Dim n As Long For i = 1 To Len(s) n = AscW(Mid(s, i, 1)) If n < 128 Then r = r & "%" & Hex(n) ElseIf n < 2048 Then p1 = n \ 64 r = r & "%" & Hex(p1 + 192) p2 = n Mod 64 r = r & "%" & Hex(p2 + 128) Else End If Next i EncodeQP2 = r End Function و لنأخذ مثال على ذلك لكي نترجم مربع نص من اللغة العربية الى الإنجليزية Dim FromLanguage, ToLanguage As String FromLanguage = "auto" ' الترجمة من أي لغة مختلفة ToLanguage = "en" ' الترجمة الى اللغة العربية [TextBox1] = Translate(EncodeQP2([TextBox1]), FromLanguage, ToLanguage) مرفق المثال لتطبيق اعلاه GoogleTran.accdb

بارك الله بك ولك اضعاف ما دعوت لي جرب الملف المرفق البرنامج الجديد 2021 (1) (12) (6).xlsm

نفس الفكرة يمكنك التوصل لها بمفردك Private Sub TextBox1_AfterUpdate() Me.TextBox2.Value = Year(Date) - Val(Me.TextBox1.Value) End Sub بالتوفيق

استاذنا العزيز الموضوع على اليوزر فورم وليس على الشيت textbox1 = المواليد textbox2 = العمر

اجعل مصدر السجلات Salarytbl وليس SalarystatementQry في زر طباعة التقرير .. اجعل شرط اذا كانت كل حقول البحث فارغة فسيكون مصدر سجلات التقرير هو جملة سكوال اختيار الكل من جدول Salarytbl وبعكسه يتم تنفيذ الكود الموجود في زر الطباعة ( اعني اذا كان احد الحقول ليس فارغا ) بصراحة لم اجربه .. لان لدي مشكلة في الحاسبة .. والانفلونزا

Press Alt + F8 and run the code Test Report.xlsm

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

السؤال نظري وعليه الإجابة نظرية ولم يتم إرفاق ملف من حضرتك فكيف يتم التطبيق او المثال ؟

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

Remove extra spaces in the months in column A then use this formula =NETWORKDAYS.INTL(1&D4,EOMONTH(1&D4,0),"1111011")

Sub Test() [B6] = GetDupUniq([B3], True) [B9] = GetDupUniq([B3], False) End Sub Function GetDupUniq(ByVal txt As String, ByVal f As Boolean) As String Dim e, s As String, i As Long With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 1 To Len(txt) s = Mid$(txt, i, 1) If s <> " " Then .Item(s) = .Item(s) + 1 Next i For Each e In .Keys If (f = True And .Item(e) = 1) Or (f = False And .Item(e) > 1) Then .Remove e Next e GetDupUniq = Join(.Keys, "-") End With End Function

العفو اخي الكريم بالنسبة للطريقة فهي بسيطة لكن يلزمك التركيز و قراءة الكود بتعمن فجميع الدوال التي كنت تستخدمها في النموذج او الاستعلام تم اضافتها للكود لا اكثر

جميعا بإذن الله ولك مثله وزيادة

شكرا استاذ محمد جزاك الله خير

تدلل استاذ الحلبي.. ياسيدي لا خبير ولاحاجة.. لسة بتعلم من هنا وهناك

وعليكم السلام 🙂 اضفت حقل مخفي في النموذج ، اسمه All ، يتم التحكم بقيمته برمجيا : . الكود خلف النموذج والازرار : All = 0 معناه جميع السجلات All = 1 معناه السجلات حسب قيم البحث Private Sub Command16_Click() Me.All = 0 Me.Requery End Sub Private Sub Command20_Click() Me.All = 1 Me.Requery End Sub Private Sub Form_Load() Me.All = 0 Me.Requery End Sub Private Sub ind_AfterUpdate() Me.All = 1 Me.Requery End Sub . وعليه ، يصبح الاستعلام q1 مصدر بيانات النموذج: . معيار xDate Between (IIf([Forms]![f1]![All]=0,#01-Jan-1900#,[forms]![f1]![str])) And (IIf([Forms]![f1]![All]=0,#01-Jan-2900#,[forms]![f1]![ind])) ومعيار xname IIf([Forms]![f1]![All]=0,[xname],[Forms]![f1]![srch_xname]) . اي: للتاريخ: اذا كانت All=0 (جميع السجلات) فاختار التاريخ بين 1-1-1900 وتاريخ 1-1-2900 ، واذا احتجت اكبر من سنة 2900 فخذ راحتك واعمل التغيير 🤣 ولحقل الصنف: اذا كانت All=0 (جميع السجلات) فاختار قيمة الحقل xname من الجدول ، مما يعني جميع السجلات 🙂 ورجاء مراجعة الرابط التالي لتتعرف على طرق البحث في الاستعلام: جعفر تحديث.zip

بارك الله فبكم جميعا

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

جميعا بإذن الله شكرا لكلماتك الطيبة أستاذ @Ali Mohamed Ali

اتفضل استخدم التالي ضع الكود في حدث عند فتح النموذج With Me.Absentsubform.Form .DataEntry = True .Filter = "" .FilterOn = False .Requery End With استخدم نفس الكود الموجود في ازرار البحث في النموذج

الأفضل انك تحول قاعدة البيانات الى SQL على سيرفر خارجي بالإمكان ان تجرب احد السيرفرات المجانية و ارشح لك سيرفر somee و بعد ذلك تقوم بربط جميع نسخ الاكسس في الفروع بقاعدة بيانات SQL ابدء بإنشاء حساب على اي مزود خدمة سواء مجانية او مدفوعة و ستجدنا في خدمتك لربط الفروع بقاعدة البيانات الخارجية

تختلف الطرق حسب طريقة الارسال كيف تقوم بإرسال البريد الإلكتروني ؟ لكن في كل حال استخدم التالي للحصول على قائمة الملفات داخل المجلد Dim fso As Object Dim oFSO As Object Dim oFolder As Object Dim oFile As Object Dim i As Integer Dim FilePath As String Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder("مسار المجلد") For Each oFile In oFolder.Files FilePath = FilePath & vbNewLine & oFile.Name Next oFile MsgBox FilePath

اعتقد صعب لان لازم سخص مرسل وشخص مستقبل الايميل حتى لو مش هيفتح الاوتلوك فهو هيعتمد على مكتبه الاوتلوك ممكن تنظر لهذا الكود Option Compare Database Private Sub cmdSendEmail_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Dim emailTo As String Dim emailSubject As String Dim emailText As String Dim outApp As Outlook.Application Dim outMail As Outlook.MailItem Dim outlookStarted As Boolean On Error Resume Next Set outApp = GetObject(, "Outlook.Application") On Error GoTo 0 If outApp Is Nothing Then Set outApp = CreateObject("Outlook.Application") outlookStarted = True End If Set db = CurrentDb Set rs = db.OpenRecordset("SELECT ArName, EnName, EmailAddress, EmailVIP " & _ " FROM QTSendEmail") Do Until rs.EOF emailTo = Trim(rs.Fields("ArName").Value & " " & rs.Fields("EnName").Value) & _ " <" & rs.Fields("EmailAddress").Value & ">" emailSubject = Me.txtEmailTital If IsNull(rs.Fields("ArName").Value) Then emailSubject = emailSubject & " for " & _ rs.Fields("ArName").Value & " " & rs.Fields("EnName").Value End If emailText = Trim("Hi " & rs.Fields("ArName").Value) & "!" & vbCrLf If rs.Fields("EmailVIP").Value Then emailText = emailText & Me.txtEmailBody & vbCrLf End If ' ' emailText = emailText & _ ' "نص 1" & _ ' "نص 2 " & _ ' "نص 3 " & _ ' "نص 4" Set outMail = outApp.CreateItem(olMailItem) outMail.To = emailTo outMail.Subject = emailSubject outMail.Body = emailText outMail.Send rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing If outlookStarted Then outApp.Quit End If Set outMail = Nothing Set outApp = Nothing MsgBox "تم ارسال الايميلات للجميع", vbInformation, "تأكيد" End Sub وجربه هتحتاج ان تضيف الاضافة دي

وعليكم السلام ورحمة الله وبركاته افضل طريقة لربط الافرع عن بعد يكون باستحدام sql وستجد شروحات كثيرة لعمل ذلك منها : تحياتي

السلام عليكم ورحمة الله جرب هذا الملف الرقم _القومى.xlsm

زيادة في اثراء الموضوع .....

أخي الكريم @عمر ضاحى انت من تستحق افضل اجابة ... وهذا رأي بارك الله فيك .... واشكر حسن ظنك في ..

شوف التعديل ده يارب يكون المطلوب من سؤولك تبين لي انك تريد حفظ الصور خارج قاعدة البيانات وكذلك تمت الاجابة علي السؤول بحفظ الصور في مجلد خارج قاعدة البيانات ويمكنك ادراج الصورة وسوف تظهر مباشرة اضافة صور.rar

If Not Isnull([كود الصنف]) then كود الحذف end if

معليش ابو عقاب جرب المرفق ..... بعد تثبيت الخط الموجود معه هل يقرأة جهاز الباركود الموجود لديك .... ناقل.rar

التاريخ في حقل تاريخ الميلاد نص وليس تاريخا تم تحوله إلى تاريخ باكواد vba وإعادة تنسيقه ووضع خلية بها تاريخ حساب السن ووضع معادلة السن باليوم والشهر والسنة بالتوفيق تنسيق رياض الاطفال - Copy.xlsx

جرب هذا الأكواد المستخدمة توضع هذه الأكواد في بداية الكود Application.ScreenUpdating = False Application.Calculation = xlManual Application.EnableEvents = False وتوضع هذه الأكواد قبل نهاية الكود قبل end sub Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdating = True برنامج التنسيق تعديل14.xlsm

اعرض الملف استخراج معلومات الرقم القومي تاريخ الميلاد والمحافظة والنوع بسم الله الرحمن الرحيم، السلام عليكم ورحمة الله وبركاته، أسعد الله أوقاتكم من جديد موعدنا اليوم مع معلومة مفيدة جدا ومتقدمة جدا، ومهمة جدا في نفس الوقت، ألا وهي شرح استخراج معلومات الرقم القومي تاريخ الميلاد والمحافظة والنوع national id info فتابعونا. شرح استخراج معلومات الرقم القومي تاريخ الميلاد والمحافظة والنوع national id info نبدأ أولا بمعرفة دلالات أرقام بطاقة الرقم القومي المصري. لكن هل يمكن استخراج تاريخ الميلاد والمحافظة والنوع ذكر أو أنثى من الرقم القومي بصورة آلية؟؟!! تابعونا للإجابة عن هذا السؤال وأكثر تابعونا في هذا الفيديو ونتعرف أيضا على: أبسط معادلات للحصول على تاريخ الميلاد والمحافظة والنوع من الرقم القومي أكواد المحافظات في الرقم القومي اقتصاص عدد معين من حروف الكلمة كيف سيكون الرقم القومي في المستقبل سنة 2100 ؟ تحويل النص إلى تاريخ معادلات if المتداخلة معادلة البحث lookup معرفة الرقم الزوجي والفردي عن طريق الدالة mod التعامل مع فهارس المصفوفات array في vba إنشاء دالة معرفة user defined function في إكسل والكثير من المهارات الأساسية في فيجوال بيسك للتطبيقات وفي معادلات إكسل لا أريد أن أطيل عليكم تابعوا معي هذا الفيديو شرح طريقة تنفيذ إجراءين بزر أمر واحد two macros by one button الشرح يعمل في إكسل 2016 و 2013 و 2010 و 2007 ولا ينقصني سوى دعاؤكم لي ولأهلي وأحبابي -وأنتم منهم- بخيري الدنيا والآخرة. ومشاركة الموضوع مع من يهمه الأمر لو بخل بها غيرك ما وصلت إليك صاحب الملف أ / محمد صالح تمت الاضافه 10 فبر, 2018 الاقسام قسم الإكسيل

ده الشغل واللا بلاش .. يحفظك ربنا استاذ محمد صالح

اقرأ هـــــــــــــــــــــــــذا

أخي الكريم نحتاج الحدث عند تغير التحديد في حالة عدم تمكن الإكسل من تحديث محتوى ورقة العمل بالدوال المضمنة فيه وفي حالتك المعادلة التي كتبتها لك وقام الأخ أحمد يعقوب مشكورا بنسخ المعادلة بالكود تفي بالغرض دون الحاجة إلى حدث تغيير التحديد فلو قمت بتغيير القيم الموجودة في الربح/الخسارة ستتغير بناء عليها قيمة العمود ملاحظة في الحال دون الحاجة إلى حدث تغيير التحديد كل عام أنتم بخير