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

يمكنك استعمال هذا الكود بعد فك دمج الخلايا وتغيير الامتداد إلى 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

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

نفس الفكرة يمكنك التوصل لها بمفردك 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")

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

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

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

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

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

جميعا بإذن الله شكرا لكلماتك الطيبة أستاذ @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 الاقسام قسم الإكسيل

يا أخي الكريم بارك الله فيك وعقبالك *** ألا تكلف نفسك محاولة فهم ما تم تغييره في الملف؟؟ الذي تم إضافته هو دالة لاستخراج mac address بواسطة الآي بي الخاص بالجهاز فلو تأملت معاملات الدالة الموجودة تحت العنوان mac address لوجدتها تحتوي على باراميتر واحد هو مرجع الخلية التي تحتوي على الآي بي الذي يأتي هو نفسه من خلال إذا كان الكمبيوتر متصلا أما إذا كان الكمبيوتر غير متصل على الشبكة فلا تستطيع معرفة الآي بي الخاصة به ولا معرفة mac address الخاصة به أتمنى أن يكون الأمر اتضح وعذرا

تفضل أخي الكريم مع ملاحظة عدم مسح المعادلة الموجودة تحت العنوان mac address كل عام أنتم بخير mas-pings2.rar

بارك الله فيك أخي أحمد على مرورك الطيب ولا تنساني من دعائك وقت الإفطار بالله عليك أن يسد الله ديني

ياريت مزيد من التوضيح ويفضل ارفاق مثال للتعديل عليه

دائما تأتي لنا بالجديد المفيد أخي محمد حياك الله

ايه الحلاوة دي اخي يحيى على فكرة ممكن عملها في الباور بوينت كمان جزاك الله خيرا

شرح رائع من الأستاذ عمودي ونقل له نفس الثواب من أخي طارق فالدال على الخير كفاعله جزاكم الله خيرا ونفع بكم

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