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

السلام عليكم 🙂 هذا كان رد اخوي احمد : بإستخدام الامر SetValue في الماكرو او الماكرو المضمن : . يجب علينا ان نعرض الجواب في الموضوع ، حتى يستطيع الاعضاء البحث عنه 🙂 جعفر

وعليكم السلام اخى @ازهر عبد العزيز اتفضل تم تغيير الزر الى ماكرو ان شاء الله يكون ما تريد بالتوفيق اخى mmm(1).accdb

وعليكم السلام 🙂 انا من مؤيدي استخدام اعدادات الاسكانر في عمله ، وهذه الاعدادات تقوم بالعمل بشكل رائع ، بدون تدخّل اي من برمجتنا 🙂 لهذا السبب ، لا تعليق عندي على كود الماسح الضوئي واليك ملاحظاتي على الكود : 1. الكود يأخذ الصور بدقة: DPI = 200 ، والمفروض للأرشفة ان تكون DPI = 300 ، 2. الكود يأخذ صورة للشاشة بحجم A4 ، فيكون هناك مكان فارغ في الكثير من الصور الصغيرة ، وفيه هدر للمساحة التخزينية : Scanner.Items(1).Properties("6151").Value = 8.3 * DPI 'Horizontal extent Scanner.Items(1).Properties("6152").Value = 11.7 * DPI 'Vertical extent for A4 3. لا ادري مقدار الضغط Compression ، لأنه للأرشفة يجب ان لا يكون هناك ضغط ، 4. وفي الواقع انك لما تأخذ صور jpg وتستعمل تقرير الاكسس لجمع هذه الصور ، ومن ثم تحولها الى pdf ، فأنت تعمل تغيير في حجم صور jpg ، وهذا يتنافى مع اصل الارشفة !! ارفقت لك برنامج يعمل كالتالي: تضع البرنامج في مجلد ، وتضع جميع صور jpg في نفس المجلد ، ثم انقر نقرتين على البرنامج ، وفي الشاشة السوداء اضغط على الرقم 1 من الكيبورد ، فتلقائيا يحول لك الصور الى ملف pdf ، وبنفس نقاوة كل صورة (جرب الصور اللي في المرفق) . طبعا لاحقا تقدر برمجيا ان تعطي البرنامج الامر عن طريق Shell مثلا 🙂 جعفر jpg to pdf.zip

رأس الصفحة Page Header يمكنك اخفاؤه برمجيا واظهاره في أي صفحة تريدها بكتابة الكود داخل التقرير من حدث تنسيق Format الكود التالي يخفي رأس الصفحة في جميع الصفحات : Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) PageHeaderSection.Visible = False End Sub ولإظهار رأس الصفحة في الصفحة الأولى فقط دون الباقي : Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) If Me.Page > 1 Then PageHeaderSection.Visible = false Else PageHeaderSection.Visible = true End If End Sub وممكن تختار رقم صفحة معينة

كلك ذوق وأخلاق وعلم أستاذ أحمد الفلاحجى وبالتوفيق أستاذ عمر omarAbdalrazaq

تم التعديل مرة أخرى و بإضافت جديدة 1-حرية اختيار الكلمة لتلوينها و تكبير الخط فيها (الخلية F1 ) 2-حرية اخنيار لون التلوين (الخلية G1 ) 3- الكود Option Explicit Sub Regex_position(aSrting As Range, ByVal My_ExP As String) Dim rex As Object Dim Array_Pos() As Integer Dim Array_Mot() As String Dim Cnt% Dim My_Match, Sing_Match Set rex = CreateObject("Vbscript.Regexp") With rex .Pattern = My_ExP: .ignorecase = True: .Global = True End With If rex.test(aSrting) Then Set My_Match = rex.Execute(aSrting) Cnt = 0 For Each Sing_Match In My_Match ReDim Preserve Array_Pos(Cnt) ReDim Preserve Array_Mot(Cnt) Array_Pos(Cnt) = Val(Sing_Match.firstindex + 1) Array_Mot(Cnt) = Sing_Match Cnt = Cnt + 1 Next For Cnt = LBound(Array_Pos) To UBound(Array_Pos) With aSrting.Characters(Array_Pos(Cnt), Len(Array_Mot(Cnt))).Font .ColorIndex = Sheets("sheet1").Range("G1") .Size = 20: .Bold = True End With Next End If End Sub '++++++++++++++++++++++++++++++++++++ Sub Colorize_Please() Application.ScreenUpdating = False Dim st, cel As Range st = "(?:^|\W)" & Range("F1") & "(?:$|\W)" 'With Range("a1:a13") With Sheets("Sheet1").UsedRange .Characters.Font.ColorIndex = 1 .Font.Bold = False .Font.Size = 16 End With 'For Each cel In Range("a1:a13") For Each cel In Sheets("Sheet1").UsedRange Call Regex_position(cel, st) Next With Sheets("Sheet1").Range("F1:G1").Font .ColorIndex = 1: .Bold = True: .Size = 20 End With Application.ScreenUpdating = True End Sub '+++++++++++++++++++++++++++++++++++++++++++++ Sub reset_me() With Sheets("Sheet1").UsedRange.Font .ColorIndex = 1: .Bold = False: .Size = 16 End With With Sheets("Sheet1").Range("F1:G1").Font .ColorIndex = 1: .Bold = True: .Size = 20 End With End Sub الملف مرفق All_Saerch_New.xlsm

وعليكم السلام اخى @محمد خالد السعيد اتفضل ان شاء الله يكون ما تريد تم معالجه الخطأ فى حقل اجمالى المصروف =IIf(IsError([daily2].[Report]![text2]);0;[daily2].[Report]![text2]) بالتوفيق اخى mohh.accdb

التعامل مع بيانات الويب من خلال FTP: إستقبال بيانات من موقع معين سوف نقوم في هذا الدرس إن شاء الله بشرح طريقة جلب بيانات من الويب من دون اللجوء إلى المتصفح تنبيه: في هذا المجال ليس لدي أي خبرة و قد أعتمدت على البحث في الويب لجمع المعلومات. فلربما أخطئ في ذكر أحد المصطلحات لذلك من لديه دراية بهذا الموضوع و راني أخطئ فالرجاء أن يصوبني. بروتوكول FTP: FTP هي اختصار لمجموعة كلمات File Transfer Protocol، وهي تعني بروتوكول نقل الملفات، وهذه الخدمة هي إحدى تطبيقات TCP/IP التي تجعل من الممكن نقل الملفات بين أجهزة الحاسب الآلي المختلفة و المرتبطة بشبكة الإنترنت. ينقسم نقل الملفات إلى نوعين: 1 ـ تنزيل الملفات Download: وهو جلب الملفات من الكمبيوتر المضيف Host إلى جهازك المحلي Local. و نستخدم الأمر Get 2 ـ رفع الملفات Uplaod: وهو إرسال الملفات من جهازك المحلي Local إلى الجهاز الخادم Host. و نستخدم الأمر Put - كل طلب يرسل Request يتم من خلاله استقبال رد Response أوامر FTP: هذه بعض الأوامر المستخدمة في بروتوكول FTP و التي سنحتاجها أو سنعمل عليها. 1-Post: يستخدم لارسال معلومات من المستخدم مثال: إنشاء موضوع جديد أو تسجيل الدخول كل هذا عبر Post Request 2-Get: يستخدم هذا الأمر لتنزيل ملف ما من جهاز الخادم أو عرض صورة أو صفحة. مثال: أقوم بإرسال طلب و استقبل ردًا Response يحتوي على أكواد html للصفحة 3-Put: يستخدم لرفع الملفات إلى جهاز الخادم 4-Open: يستخدم لإنشاء إتصال جديد مع الخادم 6-Close: يستخدم لإنهاء الإتصال مع جهاز الخادم مثال تطبيقي: سوف نستخدم هذا الموقع: https://uk.investing.com/rates-bonds/financial-futures سوف نقوم بإستيراد بيانات جدول من هذه الصفحة إلى جدول موجود في الملف و قد ربطه بمربعات نص لنلاحظ تنزيل البيانات هذا الكود المستخدم: Dim html As HTMLDocument, hTable As HTMLTable Dim Url As String Url = "https://uk.investing.com/rates-bonds/financial-futures" Set html = New HTMLDocument With CreateObject("MSXML2.XMLHTTP") .Open "GET", Url, False .send html.body.innerHTML = .responseText End With Set hTable = html.getElementById("cr1") For i = 1 To hTable.rows.length - 1 DoCmd.GoToRecord , , acNewRec Me.id = hTable.rows(i).cells(1).innerText Me.dd = hTable.rows(i).cells(2).innerText Me.t1 = hTable.rows(i).cells(3).innerText Me.t2 = hTable.rows(i).cells(4).innerText Me.t3 = hTable.rows(i).cells(5).innerText Me.t4 = hTable.rows(i).cells(6).innerText Me.t5 = hTable.rows(i).cells(7).innerText Me.t6 = hTable.rows(i).cells(8).innerText Next i شرح الكود: تعريف كائنات html Dim html As HTMLDocument, hTable As HTMLTable إنشاء إتصال جديد عبر السرفر MSXML2.XMLHTTP و إرسال الطلب: With CreateObject("MSXML2.XMLHTTP") .Open "GET", Url, False .send إستقبال الرد على شكل صفحة html: html.body.innerHTML = .responseText استخراج البيانات من الجدول الموجود في الرد الذي استقبلناه وقد قمنا بشرح التعامل مع الجداول في الجزء الأول بالتفصيل: Set hTable = html.getElementById("cr1") For i = 1 To hTable.rows.length - 1 DoCmd.GoToRecord , , acNewRec Me.id = hTable.rows(i).cells(1).innerText Me.dd = hTable.rows(i).cells(2).innerText Me.t1 = hTable.rows(i).cells(3).innerText Me.t2 = hTable.rows(i).cells(4).innerText Me.t3 = hTable.rows(i).cells(5).innerText Me.t4 = hTable.rows(i).cells(6).innerText Me.t5 = hTable.rows(i).cells(7).innerText Me.t6 = hTable.rows(i).cells(8).innerText Next i استخدام ftp.rar

السلام عليكم اخي الفاضل ABDELRAHMAN ALFAHOUM هل اعتمد علي الجدول ام الاستعلام ؟ فيه نماذج تعتمد فيها علي الجدول مثل 1- ادخال الاصناف 2 - ادخال العملاء والموردين 3- راس الفاتورة و ذيل الفاتورة او حسب تسميتك ويكون الاستعلام من ذاخل النموذج سيليكت يعني ونعتمد علي الاستعلام في البحث عن فاتورة معينة او عميل او ما نحتاج الي شراؤه لنقصه في المخزن او معرفة ارباح وخسائر او تجميع المصروفات ( ايجار + كهرباء الخ ) او معرفة كمية المشتريات والمبيعات ابدأ ووريني ونكمل سوا علي فكرة متخافش علي شغلك كل الاساتذة الموجودين عملوا برامج كتير جدا ودماغهم عاليه اكيد هتستفيد واي تساؤلات ان شاء الله انا معاك ومفيش حاجة ان شاء الله الا وليها بدل الحل 10 معظم الزملاء هنا عملوا برنامج المبيعات وفاتورة الشراء والبيع من سنين

تم عمل المطلوب يبدو ان الأمر كان سهلاً (الكومبو بوكس لا يستقبل الكتابة بواسطة الكيبورد تفادياً للخطأ) يمكن ادراج القيم فقط من حلال قائمته المنسدلة كذلك يمكنك التنقل داخل الشيت حتى ولو كان اليوزرفورم ظاهراً All_Saerch_In With_User.xlsm

برنامج جميل وسريع وصغير المساحة ، نشكرك أستاذنا العزيز/ jjafferr وأحب أن أشارك في البرنامج من أجل زيادة سهولة الاستخدام : يمكن اضافة باراميتر NOASK للأمر حتى يتم تخطي المطالبة بادخال رقم 1 j2p.exe /NOASK أو قم بوضع المرفق التالي بجوار البرنامج بعد فك الضغط No Ask.rar

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

أنا لا أتعامل مع اليوزرفورم لأن خبرتي فيه قليلة ( ولا أحبه اصلاً) ولا أي عمل من أعمالي يحتوي على يوزر فورم ممكن أن يقوم بهذا العمل احد الاساتذة ممن لديهم الخبرة الكافية باليوزرفورم

فقط استبدل الرقم 9 واجعله 109 في نفس الدالة دالة sumifs 1مع الفلترة.xlsx

شيت اكسيل به معادلة لحساب الضريبة اعتبار من 1 / 7 / 2020 بعد القانون 26 لسنة 2020 حسبة الضريبة.xls

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

تفضل تم عمل المطلوب اضافة الى عمل كود لتكست بوكس1 ليتم كتابة السريال تلقائى دون تدخل منك rr1.xlsm

الاستاذ المبدع @أحمد الفلاحجى

احسنت اخى @Gamal.Saad جزاك الله خيرا اخى @omarAbdalrazaq افضل اجابه تكون لمن اجابك وهى لاخى جمال بارك الله فيك بالتوفيق

السلام عليكم ورحمة الله لعلها تكون قائمة من ضمن القوائم التي يتم عليها "الفرز الخاص"... إذا كانت موجودة من ضمن هذه القوائم فيكفي القيام بحدفها... راجع الملف التنفيذي المرفق (وضعت خطأ في القائمة بدل حرف "الميم" حرف "الفاء").. 555.rar

اضف تلك البنود في رأس التقرير وليس رأس الصفحة

شكرا جزيلا لك أستاذ ابو تراب

تفضل كسب العمل.rar

الكود الصحيح Private Sub TextBox1_Change() Application.EnableEvents = False If ActiveSheet.FilterMode Then _ ActiveSheet.Range("A3").AutoFilter If ActiveSheet.TextBox1.Text <> "" Then Range("$A$3").AutoFilter field:=2, _ Criteria1:="=" & ActiveSheet.TextBox1.Text End If Application.EnableEvents = True End Sub

تفضل يمكنك استخدام هذه المعادلة وبكده يكون انتهى الموضوع =IF(C10<=$D$8,((C10*10%))*15%,IF(C10>=$D$8,((C10-$D$8)*15%+($D$8*10%))*55%,"")) ومبارك الترقية الى عضــو ممــيز وسننتظر مشاركاتك الإيجابية ان شاء الله فى مساعدة جميع الأعضاء احتساب المعادلة.xlsx

في الخلية K4 هذه المعادلة (وليس C4+E4+G4+I4) =SUM(C4,E4,G4,I4) واسحب نزولاً و كذلك في الخلية L4 =SUM(D4,F4,H4,J4) لأن الدلة SUM تعتبر النص(أو الفراغ) صفراً ولا تحتسبه

السلام عليكم ورحمة الله وبركاته بعد اذن أخى الفاضل سليم هذه معادلة أخرى لاثراء الموضوع =SUM(OFFSET($E$5;;MATCH($E$1;$E$4:$P$4;0)-1;;13-MATCH($E$1;$E$4:$P$4;0)))

هذه المعادلة من البداية حتى الشهر المذكور =SUM($E$5:OFFSET($E$1,4,MATCH($E$1,$E$4:$P$4,0)-1)) و هذه الاخرى من الشهر المذكور حتى النهاية =SUM($E$5:$P$5)-SUM($E$5:OFFSET($E$1,4,MATCH($E$1,$E$4:$P$4,0)-2))

نم التعديل على الملف وتفادي الخطأ انظر الى التعديل الذي جرى في معادلات العامود الاول جمع للورقه salim2.rar

مشكور اخى ابو اسامه على ردك و مساهمتك فى تفاعلك فهل لى من الاسئلة اخرى حيتى يتثنى لى فهم الموضوع و تطبيقة اولا ماذا نقصد بحرف I فى الكود السابق ثانيا من 1 الى 4 ماذا نقصد بهذا النطاق حيث ان النطاق بالنسبة لى هو حروف و ليس ارقام منتظر ردك و استفاضك فى الشرح حيث انى مازالت مبتدئ فى الفيجوال و شكرا لك