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

السلام عليكم كما عودناكم عى كل جديد فقد قمت بتصميم برنامج خاص بمحلات الجوالات لصديق لي من المملكة العربية السعودية اضع البرنامج بين ايديكم وهو مفتوح المصدر لكي تستفيدو منه الرقم السري لاكواد فيجوال بيسك 1968 والشفت ممكن به لا تحرمونا من الدعاء mobilesv.3-KSA.rar

هل يمكن لبرنامج اكسل ان يقوم بتقسيم الصورة علي مجموعة خلايا بنسبة مئوية معينة انظر لهذا الملف لتفهم ما أقصده Complete_picture.xlsx

تفضل ::بالتوفيق:: D1.accdb

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

بارك الله فيك استاذ عبد اللطيف وزادك الله من فضله

بسم الله ماشاء الله الطريقتان احلى من بعض تم تجربتهم بنجاح :: ربنا يغفر لكم ولوالديكم فى الدنيا والاخرة جزيل الشكر

ما شاء الله تبارك الله استفدنا من هذه المعلومات القيمة . شكراً لمعلمنا ابومحمد والزميل / محمد صلاح

اهلا وسهلا في الجدول نوع الحقل اختار النوع محسوب ووضعت المعيار التالي IIf(IsNull([AGA2]);[AGA1];[AGA1]-[AGA2]) ويعني اذا كان الحقل 2 فارغ تكون قيمة الحقل 3 تساوي الحقل 1 واذا لم يكن 2 فارغ تكون قيمة 3 تساوي1-2 ممتاز يا ابا ياسين بس انا فضلت عملها في الجدول لغرض حفظ القيمة للحقل 3 في الجدول ويمكن بذلك الاستفادة منها في الاستعلامات والتقارير بشكل اسهل

اتفضل بطريقه الاخ kha9009lid بس عملتها في الاستعلام 55.accdb

مشاركة مع اخي كاسر D1.accdb

ولك بالمثل شكرا لك

أخي @kaser906 شكراً لك بارك الله فيك .. حل في الصميم ومختصر نابع عن تمكن وخبرة بالأكسس .. جزاك الله خيراً .. واصلح الله شأنك .. وأدام الله خيرك وعطاك

ليس هناك مشكلة بالملف الذى ارسلته فالملف والمعادلة يعملان بكل كفاءة كما ترى أظن ان المشكلة في نسخة الإكسيل لديك فربما تستخدم نسخة اقل من 2010 او هناك مشكلة في نسخة 2019 غير مكتملة

وعليكم السلام- نورت المنتدى تفضل لك ما طلبت vehicle trip1.xlsx

أحسنت أستاذ سليم عمل رائع بارك الله فيك وزادك الله من فضله

اذا كان في الاستعلام جرب هذا IIf([AGA3]=null;[AGA1]) او هذا IIf([AGA3]="";[AGA1]) ويفضل ترفق مثال مصغر

يمكنك تجربة هذا الملف للأستاذ أحمد حمور https://www.officena.net/ib/topic/34679-دليل-هاتف-عصري-نسخه-عربيه-v2/page/3/ PHONE BOOK.xls

تفضل الكود داخل الملف #If Win64 Then Private Declare PtrSafe Function MsgBoxTimeout _ Lib "user32" _ Alias "MessageBoxTimeoutA" ( _ ByVal hwnd As LongPtr, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long) _ As Long #Else Private Declare Function MsgBoxTimeout _ Lib "user32" _ Alias "MessageBoxTimeoutA" ( _ ByVal hwnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long) _ As Long #End If Sub btnMsgbox() Call MsgBoxTimeout(0, "اللهم صلى على سيدنا محمد", "منتدى أوفيسنا", vbInformation, 0, 4000) Call Test End Sub Sub Test() Application.OnTime Now + TimeValue("00:10:00"), "btnMsgbox" End Sub رسالة الصلاة على سيدنا محمد 2.xlsm

اذا كان هناك شيتين منفصلين فلابد ومن الأفضل عمل المعادلات بهذا الكود ويتم وضع هذا الكود فى الملف المراد وضع المعادلة به ,بعد الضغط على Alt F11 ثم فتح مديول جديد ولصق هذا الكود به وربطه بزر كما فى الملف المرسل لك Sub ToList() Dim finalrow As Long Dim wsd As Workbook Dim wsl As Workbook Dim wsdd As Worksheet Dim wsll As Worksheet 'Open Book with database Set wsd = Workbooks.Open("C:\Users\Ali Mohamed\Desktop\Next.xlsx")'لابد من تغيير عنوان الملف هذا لما هو فى كمبيوترك 'Copy using Index and match to worksheet Set wsll = ThisWorkbook.Worksheets("Sheet1") With wsll.Range("g2") < 0 wsll.Range("g2").Formula = "=INDEX([Next.xlsx]Sheet1!$B$2:$B$5000,MATCH(A2,[Next.xlsx]Sheet1!$A$2:$A$5000,0))" 'Copy row down based on first cell where formula is place finalrow = wsll.Cells(Rows.Count, 1).End(xlUp).Row wsll.Range("g2").AutoFill Destination:=wsll.Range("g2:g" & finalrow) End With 'Activate sheet where formula is placed wsll.Activate wsll.Cells(1, 1).Activate End Sub أما فى حالة نفس الملف بصفحتين مختلفين فالأمر لا يحتاج سوى معادلة Index & Match عادية ولا يحتاج الأمر الى كود =IFERROR(INDEX(Sheet1!$B:$B,MATCH(A2,Sheet1!$A:$A,0)),"")

السلام عليكم 🙂 اللغة العربية هي المطلوبة هنا 🙂 المرفق المضغوط فيه مجلد وبرنامج اكسس ، والبرنامج اللي يعمل لنا QR code الموجود على الرابط التالي: https://sourceforge.net/projects/zint/ ويتم حفظ الصورة هنا Data > QR_images وعلشان كل شيء يشتغل تمام ، رجاء لا تعمل تغيير في مكان الملفات ولا المجلدات ، ولا تغيير اسمائها (طبعا تقدر تعمل اللي تريد ، بس على اساسه يجب تغيير الكود كذلك) وهي النتيجة: وخلونا نشوف من يقدر يقرأ الصورة 🙂 ----------------------------------------------------------------------------- إضافة في يوم الثلاثاء 7 / 5 / 2019 : عملت مثال يعمل على 2003 🙂 ----------------------------------------------------------------------------- إضافة في يوم الجمعة 14 / 6 / 2019 : باركود بطاقة دخول الطائرة (Boarding card) وهي من نوع PDF417 اختار الحقول اللي تريدها تظهر في QR code بإختيار مربع صح/خطأ : . والنتيجة: . و باركود 128 (ويمكن عمل اي نوع من انواع الباركود) . والتقرير (وبعد اذن اخي محمد سلامه ، فقد استعملت الصورة التي استعملها في مثاله 🙂 ) . وبهذه الطريقة نرى اننا لا نحتاج ان نحفظ صورة لكل سجل (واذا اردنا ذلك ، فنعمل تعديل في الكود ليقوم بذلك). وهذا الكود مضافا اليه عمل الباركود العادي : Private Sub Make_QR_Barcode() ' 'https://sourceforge.net/projects/zint/ ' If Len(Me.str_Text & "") = 0 Then Exit Sub Dim App_Name As String Dim Output_File As String Dim Output_Text As String Dim Encoding As String Dim Command_Line As String App_Name = Chr(34) & Application.CurrentProject.Path & "\Data\zint.exe" & Chr(34) Output_Text = Chr(34) & Me.str_Text & Chr(34) 'QR code Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "QR_code.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --scale=2 -w 10 --height=100 --barcode=58 -d " & Output_Text 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide 'Barcode 128 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "Barcode.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 -d " & Me.ID 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide 'PDF 417 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "PDF_417.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --binary --barcode=55 --mode=3 -d " & Output_Text 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide End Sub ----------------------------------------------------------------------------- إضافة في يوم الجمعة 22 / 6 / 2019 : تم عمل VCard QR ليخزن معلومات الشخص مباشرة في الموبايل 🙂 . وبإستخدام برامج الموبايل والتي تقرأ QR Code ، يمكنك حفظ معلومات VCard QR مباشرة في عناوين الموبايل 🙂 البرنامج zint الموجود في المرفق ، فيه امكانية عمل عدة انواع من QR والباركودات ، ولكن كل نوع من هذه الانواع له صيغة خاصة في عمله ، فمثلا كود VCArd QR هو: Function Add_Items() Dim VCard_Text As String 'clear field VCard_Text = "" VCard_Text = "BEGIN:VCARD" & vbCrLf VCard_Text = VCard_Text & "VERSION:3.0" & vbCrLf VCard_Text = VCard_Text & "N:" & Me.[Family Name] & ";" & Me.[Given Name] & ";" & Me.[Additional Name] & ";" & Me.[Name Prefix] & ";" & vbCrLf VCard_Text = VCard_Text & "FN:" & Me![Name] & vbCrLf VCard_Text = VCard_Text & "ORG:" & Me.[Organization 1] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 1 - Type] & ",VOICE:" & Me.[Phone 1 - Value] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 2 - Type] & ",VOICE:" & Me.[Phone 2 - Value] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 3 - Type] & ",VOICE:" & Me.[Phone 3 - Value] & vbCrLf VCard_Text = VCard_Text & "ADR;:" & ";;" & Me.[Address 1] & ";;;;" & vbCrLf VCard_Text = VCard_Text & "BDAY:" & Me.[Birthday] & vbCrLf VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 1 - Type] & ":" & Me.[E-mail 1 - Value] & vbCrLf VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 2 - Type] & ":" & Me.[E-mail 2 - Value] & vbCrLf VCard_Text = VCard_Text & "NOTE:" & Me.Notes & vbCrLf VCard_Text = VCard_Text & "URL:" & Me.[Website 1] & vbCrLf VCard_Text = VCard_Text & "END:VCARD" Add_Items = VCard_Text End Function والذي يختلف عن PDF417 والذي يختلف عن غيره. المرفق في ملفين بصيغة txt والذي فيهما جميع الاوامر التي يمكن استعمالها لعمل مختلف انواع الباركود 🙂 ----------------------------------------------------------------------------- إضافة في يوم السبت 2 / 11 / 2019 : هنا مثال لعمل بطاقة عمل ID.zip ، بأصغر حجم QR code (رجاء ابقاء حجمه ، فقد توصلت الى هذا الحجم والكود بعد محاولات ساعات طويلة) : . وهذا هو QR code . اما تفاصيل عمل البطاقات ، فهذا الرابط فيه تفاصيل كاملة: . جعفر ملاحظة: 1. المرفق في هذه المشاركة هو البرنامج الاخير ، وفيه جميع التعديلات التي في بقية المشاركات. 2. الـ api التي تنتظر إنتهاء الامر ، ثم تنتقل للسطر التالي في الكود اسمها ShellWait ، هذه لا تتعامل مع Unicode / utf-8 / ومنها الحروف العربية بطريقة صحيحة : http://access.mvps.org/access/api/api0004.htm بينما هذه تمام : https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas zint QR 3.zip ID.zip Shell_n_Wait_2021-12-13.txt.zip

السلام عليكم ورحمة الله وبركاتة هذا مثال يتم من خلاله ربط الجداول برمجيا بدون تدخل من المستخدم عند فتح قاعدة الواجهات kaser906 يتم ربط الجداول بقاعدة جداول kaser906_be والقاعدة الثانية kasr9062 وكلتا القاعدتين مغفلتين برقم سري 1234 ضع المجلد في أي مكان او غير أسم المجلد وفتح قاعدة بيانات الواجهات kaser906 ستجد أن ربط الجداول تم بدون تدخل منك ::بالتوفيق للجميع :: TablLinkind.rar

السلام عليكم : اخوان اشلون اعمل زر حفظ البيانات بـ نعم او لا واذا عملت نعم يتم عمل نسخ احتياطية مع تاريخ اليوم والخروج من قاعدة البيانات

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

الاخوة الاعزاء محتاج معيار استعلام :- لو الحقل AGA3 فارغ يساوى قيمة الحقل AGA1

طريقة سهلة لضبط الحجم اثناء التكبير والتصغير للنموذج تحافظ الايقونات على الحجم حيث تكبر وتصغر مع النموذج الخطوات : 1- جعل الايقونات مكدس 2- تصغير الحجم الى نصف نقطة عرض والى 1 من عشرة ارتفاع 3- جعل الارتساء الافقي والعامودي كلاهما 4- جعل النموذج منبثق 5- اختار يمكن تغيير حجمه وليس مربع حوار خدعة الضبط للنماذج.accdb

جرب غير نوع الخط بالمتصفح

جرب هذا .... لأن المشكلة غير موجودة عندي فلذلك لا استطاع التجربة ... Application.FollowHyperlink "http://www.google.com/search?q= " & Me.title.Value & ""

جميع المتصفحات

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

تم وضع مثال على الرابط التالي

عمل مبارك ورائع أخي وصديقي عبداللطيف وإلى الأمام

وعليكم السلام بارك الله فيك استاذ عبداللطيف شغل جميل -عاشت ايدك

اشكرك على المرور يا غالي العلم لا يحتكر

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

انا عندي مافي اي مشكله للعلم انا استخدم اوفيس عربي 2010

اتاكد من هذه انا متاكد مافي شي غير اللغه

هذه للدلالة على الحقل المطلوب مقارنت قيمته في النموذج بدون الاشارة الى النموذج حقل رقمي وعلامتي & تدله ان الحقل موجود بالنموذج اما هنا فقد استخدمت الاشارة الى النموذج مباشرة لأستغني عن تعريف نوع الحقل وهو حقل نصي ويمكننا جعل الكود بهذا الشكل اذا لم نرد الاشارة الى النموذج وتعريف الحقل الرقمي والنصي x = DCount("[id_mdasa]", "[copy_mdars]", "[id_mdasa]=" & Me.id_mdasa & " AND [amm_mdesa]='" & Me.amm_mdesa & "'") ::بالتوفيق::

بعد إذن أستاذنا الفاضل علي تم وضع تقييد العمودين D و E بحيث لو أحد خلايا العمودين غير فارغ لا يقبل الكتابة في الخلية المقابلة لعمود الخلية الأخرى وأيضًا لإثراء الموضوع تم اختصار المعادلة وتؤدي نفس الغرض تفضل الملف المرفق 11.xlsx

فهمت قصدك وهذا أخر تعديل وأرجو أن يكون هو المطلوب أخر تعديل.rar

من خصائص مربع النص طبق هذه الخصائص :::::: محاذاة النص ............. توزيع اتجاه القراءة ............. اليمين لليسار الهامش الايسر .......... 1 سم الهامش العلوي ........ 0.199 سم الهامش الايمن ......... 1 سم الهامش السفلي ....... 0.199 سم تباعد الاسطر .......... 1 سم

تفضل أخي محمد بعد تعديل بيانات اضغط على زر "حفظ بيانات" في اسفل النموذج BK .accdb

هذا الملف من اعمال استاذ عماد غازى لعله بفى بالغرض Total Amount from Listbox.xlsm

بعد اذن استاذى الجليل ومعلمى القدير ووالدى الحبيب الاستاذ المبجل استاذ @jjafferr هذه النسخه المحموله من البرنامج وبضاعتكم ترد اليكم لو تتذكر يا معلمى موضوعكم الشيق احمل ملفاتك الهامة بقاعدة البيانات 1- عند الفتح للقاعدة للمرة الاولى يتم الاتى انشاء مجلد رئيسى بمسار القاعدة باسم Program Files بتم داخله انشاء مجلد باسم Utility يحتوى على 1- zint.exe برنامج منشئ الباركود 2-Commandline.txt الاوامر الخاصة بمنشئ الباركود 3-manual.txt دليل الاستخدام 4-QR_&_Barcode_Reader_(Pro)_2.2.4-P.apk برنامج ماسح الاكواد للجوالات التى تعمل بنظام الاندرويد نسخة كاملة ومحدثه يتم كذلك انشاء مجلد باسم QR images يحتوى على 1- QRCode.png صورة الباركود لهذا النوع QR Code 2- PDF417.png صورة الباركود لهذا النوع PDF 417 3- Barcode.png صورة الباركود لهذا النوع Code 128 بخصوص برنامج الجوال لنظام الاندرويد QR_&_Barcode_Reader_(Pro)_2.2.4-P.apk هذه الصور توضح الانواع التى يستطيع مسحها وقراءة بياناتها على الجوال كما ان للبرنامج مميزات رائعة QR-Code_Generator.zip

السلام عليكم ورحمة الله تعالى وبركاته استاذى الجليل ومعلمى القدير ووالدى الحبيب الاستاذ @jjafferr سلمت يمينك على هذه الهدية القيمة الرجاء تثبيت الموضوع مرة اخرى بقسم الاكسس واسمحوا لى ان اهديكم هذا التطبيق الاكثر من رائع تطبيق pro qr barcode scanner.apk للاندرويد QR_Scanner-v2.1.9-P.zip

السلام عليكم ورحمة اله استخدم هذا الكود Sub DelRows() Dim x As Integer, i As Long, y As Long y = Sheet1.Range("A" & Rows.Count).End(xlUp).Row For i = y To 2 Step -1 x = WorksheetFunction.Days360(Cells(i, "A"), Date) If x < 45 Then Cells(i, "A").EntireRow.Delete End If Next End Sub

السلا عليكم ورحمة الله وبركاته شهر مبارك وكل عام وانتم بخير كود لتحويل المعادلات الى قيم Option Explicit Sub Kh_Formula_To_Value() Dim MyCalcu As XlCalculation With Application MyCalcu = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With '===================================== '////////////////////////////////////// '===================================== ' هنا تضع النطاق والمعادلة التي تريد تحويلها قيم ' Formula_To_Value باستخدام '===================================== ' T هنا المعادلة اللي في العمود Formula_To_Value Range("T5:T30"), "=RC[-2]*RC[-1]" ' x هنا المعادلة اللي في العمود ' مثل عمل كود الاخ كيماس Formula_To_Value Range("X5:X30"), "=IF(COUNTIF(RC16:R30C16,RC16)=1,SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20)),"""")" ' Y هنا المعادلة اللي في العمود Formula_To_Value Range("Y5:Y30"), "=SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20))" '===================================== '////////////////////////////////////// '===================================== With Application .ScreenUpdating = True .Calculation = MyCalcu End With End Sub ================================================= Sub Formula_To_Value(MyRng As Range, MyFormula As Variant) With MyRng .ClearContents .Formula = MyFormula .Cells = .Value End With End Sub وهو طلب احدهم في الموضوع http://www.officena.net/ib/index.php?showtopic=37827 المرفق ملف اكسل 2003 كود تحويل المعادلات الى قيم.rar

استاذى الكريم العلامه عبدالله باقشير لا حرمنا الله من ابداعتك زادك الله علما تقبل تحياتى

و للتجميع هذه طريقة أخرى فعالة = نعم أستاذ بارك الله فيك الخاصية evaluate تقوم بتقييم أى معادلة يعنى لو عندك معادلة شغالة بدون مشاكل فى الشيت يمكنك تقييمها من خلال الكود باستخدام evaluate و تقييمها معناه حسابها و إرجاع قيمتها النهائية " القيمة و ليس المعادلة كما شاهدت فى ملفك بشرط ألا تزيد حروفها على 255 حرفا أيضا لا نضع علامة "=" معها هكذا Range("x5") = Application.Evaluate("SUMPRODUCT((P5:P1500=P5)*(T5:T1500))" و هذه الخاصية مشابهة لخاصية calculate = هذا المطلوب بسطر واحد من الكود وبدون أن تظهر المعادلة أصلا فى الخلية درة غالية لكن ما تغلى عليكم كل عام أنتم بخير أخى ضع السطر التالى فى حدث نقر الزر Range("x5") = Application.Evaluate("SUMPRODUCT((P5:P1500=P5)*(T5:T1500))") كما يمكنك استخدام دالة sum هكذا Range("x5") = Application.Evaluate("SUM((P5:P1500=p5)*T5:T1500)") رابط المشاركة

نسيت أفول جزى الله الأستاذ خبور عنا خيرا هو من علمنا هذه الحيلة