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

جرب هذا الملف ..اذا تم كتابة اسم الورقة خطا ستظهر لك رسالة تجنبا لاي خطا بالكود لا تحتاج الى زر للورقة الاولى الازرار للاوراق الاخرى عند الرجوع للصفحة الرئيسية . ACTIVATION.xlsm

ربما تنشيط ورقة عمل.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته ..تفضل اخي Worksh.xlsm

السلام عليكم 🙂 الجوازات والبطاقات الشخصية والهويات الحكومية ، في اسفلها كود يسمى MRZ وفيه معلومات من الوثيقة ، الجواز ، وفي اسفله سطرين من كود MRZ : . والهوية ، وفي اسفلها 3 اسطر من كود MRZ : . وهناك عدة اجهزة (هي في الواقع سكانرات) التي يمكنها قراءة هذه الوثائق ، وتستعمل نظام OCR وتحول الصورة الى نص ، ومن ضمن هذه الاجهزة ، جهاز 3M CR100 https://www.gemalto.com/govt/document-readers/cr100 والظاهر ان هذا الجهاز معتمد من قِبل البوابة الالكترونية الموحدة لحجاج الخارج . . تنزيل وتنصيب برنامج التشغيل : http://www.3m.com/ssdcp/3M Swipe Readers/SDK/3M Swipe Reader SDK 1.2.1.2 Setup.exe خلونا نستعمل هذا الجهاز عن طريق الاكسس 🙂 بعد تنصيب برنامج تشغيل الجهاز ، يقوم برنامج الاكسس بتشغيل برنامج الجهاز في الكمبيوتر (فإذا ما عملت تنصيب للبرنامج ، اوقف عمل السطر : ) Private Sub Form_Load() On Error GoTo err_Form_Load 'turn ON the scanner xml program ' Call Restart_XML '<<< اوقفوا عمل هذا السطر . النموذج يكون جاهز على الحقل Line_0 ، والذي يبدا بأخذ نتيجة OCR ، . . وتكون النتيجة بهذه الطريقة (انا وضعت الارقام امام الاسطر) : 0'START 1'OCR Line 1: IDOMN1900000<<3<<<<<<<<<<<<<<< 2'OCR Line 2: 7008529M2018227OMN<<<<<<<<<<<6 3'OCR Line 3: ALI<MOHAMMED<HUSSAIN<<AL<MOOSA 4'MSR Track 1: 5'MSR Track 2: 6'MSR Track 3: 7'End . لعمل البرنامج ، اضطررت لعمل الاكواد بنفسي ، لأن SDK الجهاز كانت للغات اخرى غير VBA ، وهذه الوحدة النمطية التي تقوم بتفكيك الكود اعلاه ، سواء لجواز او بطاقة او فيزا : Public Function Parse_MRZ(frmN As String) On Error GoTo err_Parse_MRZ ' '08-06-2018 'by jjafferr ' Dim L1 As String Dim L2 As String Dim L3 As String Dim gDocType As String Dim Pass_Type As String Dim gLastName As String Dim gFirstName As String L1 = Replace(Forms(frmN)!Line_1, "OCR Line 1: ", "") L2 = Replace(Forms(frmN)!Line_2, "OCR Line 2: ", "") L3 = Replace(Forms(frmN)!Line_3, "OCR Line 3: ", "") gDocType = Mid(L1, 1, 1) Select Case gDocType Case "P", "V" 'passport , Visa Forms(frmN)!gDocType = gDocType 'LINE 1 Pass_Type = Mid(L1, 2, 1) 'Either < or Passport type Forms(frmN)!gIssuing = Mid(L1, 3, 3) gLastName = Mid(L1, 6, InStr(L1, "<<") - 6) gLastName = Replace(gLastName, "<", " ") Forms(frmN)!gLastName = Trim(gLastName) gFirstName = Mid(L1, InStr(L1, "<<") + 2, InStr(InStr(L1, "<<") + 1, L1, "<<") - InStr(L1, "<<") - 2) gFirstName = Replace(gFirstName, "<", " ") Forms(frmN)!gFirstName = Trim(gFirstName) Forms(frmN)!gDocNumber = Mid(L2, 1, 9) 'LINE 2 Forms(frmN)!gCountry = Mid(L2, 11, 3) Forms(frmN)!gDOB = DateSerial(Mid(L2, 14, 2), Mid(L2, 16, 2), Mid(L2, 18, 2)) Forms(frmN)!gGender = Mid(L2, 21, 1) Forms(frmN)!gDocExpiry = DateSerial(Mid(L2, 22, 2), Mid(L2, 24, 2), Mid(L2, 26, 2)) Forms(frmN)!gAddInfo = Mid(L2, 29, InStr(L2, "<<") - 29) Case "I", "A", "C" 'ID Forms(frmN)!gDocType = Mid(L1, 1, 2) Pass_Type = Mid(L1, 2, 1) 'Either < or completing the first letter Forms(frmN)!gIssuing = Mid(L1, 3, 3) Forms(frmN)!gDocNumber = Mid(L1, 6, InStr(L1, "<<") - 6) Forms(frmN)!gDOB = DateSerial(Mid(L2, 1, 2), Mid(L2, 3, 2), Mid(L2, 5, 2)) 'LINE 2 Forms(frmN)!gGender = Mid(L2, 8, 1) Forms(frmN)!gDocExpiry = DateSerial(Mid(L2, 9, 2), Mid(L2, 11, 2), Mid(L2, 13, 2)) Forms(frmN)!gCountry = Mid(L2, 16, 3) gFirstName = Mid(L3, 1, InStr(L3, "<<") - 1) 'LINE 3 gFirstName = Replace(gFirstName, "<", " ") Forms(frmN)!gFirstName = Trim(gFirstName) gLastName = Mid(L3, InStr(L3, "<<") + 2) gLastName = Replace(gLastName, "<", " ") Forms(frmN)!gLastName = Trim(gLastName) End Select Exit_Parse_MRZ: Exit Function err_Parse_MRZ: If Err.Number = 9 Then 'susbcription out of order, ignore Resume Next ElseIf Err.Number = 13 Then 'Type mismatch, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_Parse_MRZ End If End Function برنامجي الذي في الخدمة ، يقرأ بيانات الجوازات والهويات في اقل من 3 ثواني ، بالأضافة الى قراءة باركود بعض الهويات الاخرى ، وادخال يدوي لأنواع اخرى من الهويات ، لهذا السبب كان يتطلب مني استعمال هذه الاحداث🙂 Public Sub Line_0_BeforeUpdate(Cancel As Integer) Private Sub Line_0_KeyDown(KeyCode As Integer, Shift As Integer) Private Sub Line_0_AfterUpdate() Private Sub Line_7_AfterUpdate() . احد اهم الامور التي اخذت مني وقت طويل لمعرفتها هي ، يجب ان تكون لغة الكيبورد بالانجليزي ، وقت قراءة البطاقة ، وإلا فالنتائج تعطيك خطأ ، لهذا السبب فالبرنامج تلقائيا يحول اللغة الى انجليزي ، لما التركيز يكون في حقل Line_0 🙂 الجدول و الكود قد يكون فيه بقايا من برنامجي ، ولكن لن يضروكم ان شاء الله 🙂 جعفر CR100 card reader.zip

السلام عليكم ورحمة الله استخدم هذا الكود Sub SeaechData() Dim Sh As Worksheet, ws As Worksheet Dim LR As Long, i As Long, C As Range Dim ShNam As String Set Sh = Sheets("ورقة11") For Each ws In Worksheets If ws.Name <> Sh.Name Then LR = ws.Range("A" & Rows.Count).End(3).Row i = 7 Do While Sh.Cells(i, 6) <> "" For Each C In ws.Range("A1:A" & LR) If C.Value = Sh.Cells(i, 6) Then ShNam = ws.Name Sh.Cells(i, 7) = ShNam End If Next i = i + 1 Loop End If Next End Sub

بناء على شرحك في المنشور الاول 816/52.39=15.57549 ثم يتم ضربها مثلا للصنف الاول 15.57549X14=218 وعند جمع اجمالي توزيع القيمة على كل الكميات يعطيك اجمالي الشحن 816 لا تستغرب لا احد يخوض في موضوعك لانك لم تضع امثلة كيف يكون ناتجك . اذا لم يكن ما تريده ربما شخص اخر يفهم سؤالك . انا اكتفيت الى هنا علي افساح المجال لغيري . بالتوفيق .

هل تنتظر ان يقوم أحد بتصميم الملف لك على الجاهز؟!!! ..لا يمكن العمل من خلال الصورة , كما لا يمكن العمل على التحمين .. فتجنباً لإهدار وقت كل من يطلع على مشاركتك دون جدوى أو أهمية فعليك برفع ملف مدعوم بشرح كافى عن المطلوب مع وضع شكل النتائج المرجوة .. وعلى فكرة نبهنا كثير جداً على هذا الأمر فلا وجود لأى مشاركة بدون الملف وشكراً !!! وبما انك لم تقم برفع الملف فكان عليك لزاماً استخدام خاصية البحث بالمنتدى فبه طلبك !! كيفية دمج عدة شيتات بهيدرز واحدة في شيت واحد باستخدام الكويري معادلة تجميع جميع صفحات الملف بصفحة واحدة كود دمج ونقل البيانات من كل صفحات الملف الى صفحة واحدة كيفية دمج أوراق العمل أو المصنفات أو دمجها في ورقة عمل واحدة؟

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

انقل العناوين كما في الصورة من رأس الصفحة الى رأس التقرير .... انظر ....

Sub create_a_sheet_if() Dim mhName As String mhName = Sheets("ورقة3").Range("a2").Value Application.ScreenUpdating = False On Error Resume Next Worksheets(mhName).Activate Application.ScreenUpdating = True End Sub

السلام عليكم أحسنت أخي @مهند محسن صيانة الحقوق الفكرية واجبة ، ويمكن للأخ السائل أن يستفيد مما لم يقم صاحب الملف بحمايته كيف يشاء. ولكن الأفضل وبما أن المنتدى تعليمي أن يقوم بعض السادة الخبراء بإعطاء دروس تتعلق باستخدام الدوال والـ VBA وأن يقوم صاحب الملف مفتوح المصدر بشرح وافٍ للاستفادة من الخبرات ، وليس فقط للاستهلاك كما هو واقع المحاسبين في كثير من المجالات يطبقون برامج معدّة مسبقاً فقط ...للأسف.تقبلوا تحياتي ومروري ..والسلام عليكم.

مع العلم ان طريقتك لم اقتنع بها لان البيانات اساسا تخزن دون الحاجة الى الضغط على حفظ ..... لكن تفضل ملفك .... supertest.accdb

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

جزاك الله خسر الثواب وأكرمك الله وأحسن الله اليك

أحسنت أستاذنا الكريم وبارك الله فيك .. طبعاً موضوع مهم وقيم , جعله الله فى ميزان حسناتك

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

وعليكم السلام ..بما انك لم تقم برفع ملف ,,فكان عليك استخدام خاصية البحث بالمنتدى فطلبك تكرر كثير جداً وشوف بنفسك : وده كمان مثال بملف مرفق لك وكلمة السر لإظهار الصفحات : 123 اخفاء الشيتات و ترك الشيت الرئيسي هو الظاهر كود اخفاء الشيتات عدا شيت محدد اخفاء الصفحات تلقائيا اخفاء أوراق العمل وعدم اظهارها فورم_كود اظهار و اخفاء للصفحات Sheets Hidding - 2.xlsm

وعليكم السلام أهلاً بك فى المنتدى -تفضل لك ما طلبت ويجب عليك اتباع الخطوات كما بالصورة حدود الصفحة.xlsm

يمكنك استخدام هذه المعادلة لطلبك ..معادلة مصفوفة (Ctrl+Shift+Enter) =IFERROR(INDEX(Table2[التاريخ],SMALL(IF(Table2[اسم الموقع/ المخزن]=$C$3,ROW($A$4:$A$11)-ROW($A$4)+1),ROWS(A$1:A1))),"") كشف حساب مشروع1.xlsx

وعليكم السلام -تفضل بهذه المعادلة سحباً لليسار ثم الى الأسفل =COUNTIFS(data!C$2:C$1000,"<>"&"",data!$A$2:$A$1000,$B4,data!$B$2:$B$1000,1) trasnport1.xlsx

فقط يمكنك استخدام هذه المعادلة أو بعمل تنسيق للخلايا بأن يكون تنسيق الخلية يوم وليس تاريخ B2dddd =TEXT(B3,"b2dddd") هاجر البصمة1.xlsx

كان عليك استخدام خاصية البحث بالمنتدى قبل طرح مشاركتك فبه طلبك -تفضل https://www.officena.net/ib/search/?&q=تفقيط مساحة&search_and_or=and&sortby=relevancy

أحسنت استاذ عادل عمل رائع شكراً جزيلاً لجهودكم

بارك الله فيك وزادك الله من فضله

وعليكم السلام .. يمكنك استخدام هذه المعادلة فى عمود المعدل G =F2/COUNT(B2:E2) وهذه المعادلة لعمود الحالة E =IF(D11<>"","مفصول",IF(C11<$A$9,"متخرج","مزاول")) كتابة الدالة1 if.xlsx

وعليكم السلام-تفضل على الرغم انك لم تقم برفع ملف توضيحى لطلبك =LEN(A1)

جرب هذا الكود تم تغيير اسم الصفحة الرئيسية الى اللغة الأجنبية (Central) لسهولة نسخ الكود ولصقة (دون ظهور احرف غريبة فيه) Option Explicit Sub One_For_all() Dim Ar_sheet() Dim m%, x%, Ro%, Itm, ct_ro% Dim Rg As Range, CT As Worksheet Dim ct_rg As Range Dim Var_rg As Range, var_ro%, var_col% Application.ScreenUpdating = False Set CT = Sheets("Central") Set ct_rg = CT.Range("A1").CurrentRegion ct_ro = ct_rg.Rows.Count If ct_ro > 1 Then ct_rg.Offset(1).Resize(ct_ro - 1).Clear End If For m = 0 To Sheets.Count - 1 If Sheets(m + 1).Name <> CT.Name Then ReDim Preserve Ar_sheet(m) Ar_sheet(m) = Sheets(m + 1).Name End If Next m = 2 For Each Itm In Ar_sheet Set Var_rg = Sheets(Itm).Range("A1").CurrentRegion var_ro = Var_rg.Rows.Count var_col = Var_rg.Columns.Count If var_ro > 1 Then CT.Cells(m, 2).Resize(var_ro - 1, var_col - 1).Value = _ Sheets(Itm).Range("B2") _ .Resize(var_ro - 1, var_col - 1).Value m = m + var_ro - 1 End If Next Itm If m > 2 Then With CT.Range("A2").Resize(m - 2, var_col) .Columns(1) = Evaluate("Row(1:" & m - 2 & ")") .Borders.LineStyle = 1 .InsertIndent 1 .Font.Bold = True .Font.Size = 14 .Interior.ColorIndex = 35 End With End If Application.ScreenUpdating = True End Sub الملف مرفق Moustafa7.xlsm

هشــــام الســـورى أين انت من هذه الإجابة الممتازة؟!!! لم أرى اى ضغط على الإعجاب من طرفك , وهل جزاء الإحسان الا الإحسان ؟!!!! أين الضغط على الإعــــجـــــاب , وكما اتفقنا ان هذا أقل ما يقدم لمن له الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ؟!!! 💙

السلام عليكم ورحمة الله وبركاته أقدم لكم اليوم برنامج لتسجيل بيانات أجازات الموظفين -بارك الله فيكم ..الباسورد: 123 برنامج اجازات الموظفين.xlsm

اخوانى الكرام الملف يعمل عندى وهذه صورة الواجهة وسأرسل الملف مرة اخرى برنامج اجازات الموظفين.xlsm

السلام عليكم أهل المنتدى الكرام أقدم اليكم اليوم برنامج متخصص فى الفواتير والمخازن يارب يعجبكم ..بارك الله فيكم وغفر لكم takala-برنامج المحاسب العربى.rar

تفضل أخى علاء هذا البرنامج برنامج حساب مكافأة الامتحانات لغير النقابيين من اعداد الاستاذ محمد عبدالله.xls

أخى معادلة أستاذنا سليم تعمل بكل بكفاءة لعلك غفلت أو نسيت أن تضغط على Ctrl+Shift+Enter فهى معادلة مصفوفة ولكم جزيل الشكر

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

وعليكم السلام لقد تم الحل من قبل استاذنا الكبير ياسر خليل فورمة بحث في الشيتات - اظهار المراحل لاختصار طبع الفاتورة.xlsm

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