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

السلام عليكم اخوتي الكرام اهدي العمل المتواضع اداة معلومات الموردين Suppliers Info Tool - مفتوح المصدر لكم لعلا هناك من يجده مفيدا. تم تصميمه من قبلي لجهة العمل التي اعمل بها لهذا لك كامل الحرية للاستفاذة منه و تعديله وليس لها اي حقوق. حسابات الدخول User Password ================ admin 123 Log 123 View view بالتوفيق YEM_LOG_DB.accdb

أهلا بك @ابو البشر بالنسبة للرقم (1): المنهج GetRows يعيد عدد من صفوف بيانات الجدول المشار إليه في المتغير الغرضي XLRS. والرقم بين القوسين يبين عدد الصفوف المطلوب إعادتها.. المنهج GetRows يعيد مصفوفة بيانات من حدين؛ الحد الأول يمثل رقم عمود البيانات (الحقل) في الجدول والثاني يمثل رقم الصف البيانات (السجل).. هذه الحدود يبدأ ترقيمها بالرقم 0 يجب اسناد المنهج GetRows إلى متغير مصفوفة بيانات عامة غير معينة الحدود.. وهو هنا RCROW؛ وهو المشار إليه بالرقم (2). وكمثال (0,0)RCROW يعيد قيمة العمود الأول من الصف الأول في جدول البيانات. بالنسبة للرقم (3) :عند تجهال أسماء أعمدة البيانات المستوردة من أكسل يقوم أكسس بوضع أسماء مزيفة تبدأ بـ (F1)؛ و (F) اختصار كلمة Field و(1) رقم عمود البيانات في أكسس.. إذا كانت ورقة البيانات في أكسل تحتوي على أسماء للأعمدة فيمكن تغيير ذلك من خصائص استيراد البيانات؛ إما على مستوى مصنف البيانات أو على مستوى ورقة بيانات محددة... بالنسبة للرقم (4): يمكن الاستغناء عن المحدد، أو توسيع نطاقه.. لكن لا يمكن استخدام نطاقات متعددة في المجال الواحد.. أرجو أن يكون هذا التفسير واضحاً ومفهوماً ..

لا مشكلة اخي العزيز نعم كان هناك اشكالية مع اصدار 2007 وتم عمل تحديث وانتهت المشكله

جرب هذا الملف الكود Option Explicit Sub From_sheet_to_Form() With Sheets("Salim") If .Range("N6") = vbNullString Then Exit Sub .[P8] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,2,0)") .[N8] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,3,0)") .[P10] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,4,0)") .[N10] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,5,0)") .[Q12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,6,0)") .[O12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,7,0)") .[M12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,8,0)") End With End Sub '+++++++++++++++++++++++++++++++++++++++ Sub add_to_data_val() Dim arr(), m%, i%, lr% Dim s As Worksheet Set s = Sheets("Salim") lr = s.Cells(Rows.Count, 1).End(3).Row i = 2: m = 1 Do Until i = lr + 1 If Application.CountIf(s.Range("A2:A" & i), s.Range("A" & i)) = 1 Then ReDim Preserve arr(1 To m) arr(m) = s.Range("A" & i) m = m + 1 End If i = i + 1 Loop ReDim Preserve arr(1 To m) arr(m) = s.Range("N6") With s.Range("N6").Validation .Delete .Add 3, Formula1:=Join(arr, ",") End With s.Range("A" & lr + 1) = arr(UBound(arr)) s.Range("N6") = arr(UBound(arr)) End Sub '++++++++++++++++++++++++++++++++++++++++++++ Sub Form_To_sheet() Dim s As Worksheet Dim rg As Range, RO% Dim lr%, Answer As Byte Set s = Sheets("Salim") lr = s.Cells(Rows.Count, 1).End(3).Row If Application.CountIf(s.Range("A2:A" & lr), s.Range("N6")) = 0 Then Answer = MsgBox("This code dosn't exixts!.. " & Chr(10) & _ "Do you like to add it", 4) If Answer = 6 Then add_to_data_val Exit Sub End If End If Set rg = s.Range("A1:A" & lr).Find(s.[N6], lookat:=1) If rg Is Nothing Then Exit Sub RO = rg.Row With s .Range("A" & RO) = .[N6]: .Range("B" & RO) = .[P8] .Range("C" & RO) = .[N8]: .Range("D" & RO) = .[P10] .Range("E" & RO) = .[N10]: .Range("G" & RO) = .[Q12] .Range("H" & RO) = .[O12]: .Range("I" & RO) = .[M12] End With End Sub الملف مرفق Vice_versa.xlsm

هلا اخي جرب المرفق TEST.accdb

كل عام وحضراتكم بخير ورمضان كريم اعاده الله عليكم وعلى الامة الاسلامية بالخير واليمن البركات البحث فى القرآن الكريم.xlsm

السلام عليكم ورحمة الله وبركاته الاخوة الأفاضل تقبل الله طاعاتكم وجعلنا واياكم في هذا الشهر الكريم من عتقائه من النار. وبعد أحتاج بعض الأفكار لمن سبقني بمجال برامج البيع (كالسوبر ماركت - ونقاط البيع) حيث أن في هذا المجال يكون الصنف به أكثر من وحدات قياس أو تعبأة مثلا صنف كالسكر مثلا وحدة القياس هنا الوزن - وطريقة التغليف تكون علي شكل أكياس كبيرة تحوي 10 أكياس صغيرة من فئة 1 كيلو جرام فاذا كانت الكمية المشتراة مثلا 1 طن فهذا يعني أن الكمية هي عبارة عن 100 كيس كبير (لفة أو شكارة أو أي مسمي قريب مما هو مألوف فأنا لا أدري خارج مصر كيف تكون التسميات) وفي نفس الوقت = 1000 كيس صغير سعة 1ك جرام وهكذا دوليك للاصناف المختلفة في وحدات القياس و التعبأة ونظام التغليف أرجوا ممن له سبق بهذا المجال يفيدني بما منّ الله عليه من طريقة معالجة هذه المسألة عند التعامل مع الكميات المتاحة والمنصرفة والرصيد المتبقي. وجزاكم الله خيرا

السلام عليكم ورحمة الله وبركاته ..... جميع اعضاء المنتدى ..... كل عام وانتم بخير وأسأل الله عز وجل أن يتقبل منا ومنكم صالح الاعمال استفسار حول كود سابق شارك في موضوعة في هذا الموضوع الأساتذة : @فايز و @Barna و @jjafferr و @أبو إبراهيم الغامدي في هذا الموضوع ولدي عدد من الاستفسار على الكود التالي بارك الله فيكم : Option Compare Database Option Explicit Sub IMPORT_XLSDB() On Error GoTo SUB_CLOSE '-- OPEN CURRENT DATABASE AS LOCAL DB Dim DB As DAO.Database Set DB = CurrentDb '-- OPEN RS DB TO ADD DATA Dim DBRS As DAO.Recordset Set DBRS = CurrentDb.OpenRecordset("TABLE") '-- OPEN XLS FILE AS REMOTE DATABASE Dim XLDB As DAO.Database Set XLDB = OpenDatabase( _ CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;") '-- OPEN XLS SHEET AS REMOTE RS Dim XLRS As DAO.Recordset Dim RCROW() Dim RC As Long Dim I As Integer Dim TD As DAO.TableDef '-- LOOP THROUGH XLDB TABLES (SHEETS) For Each TD In XLDB.TableDefs '-----------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (C) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing '--------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (I) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing Next SUB_CLOSE: '-- COLOSE XLDB AND XLRS Set XLRS = Nothing ' XLDB.Close Set XLDB = Nothing '------------------------' '-- CLOSE DB AND DBRS Set DBRS = Nothing XLDB.Close Set XLDB = Nothing End Sub 1- ما المقصود في الاؤقام المسجلة في 1 و 2 2- ما المقصود ب F1 و هل يمكن تغيير النطاق في 4 وكيف يتم ذلك لو اغترضنا أن ملف الاكسل نريد جلب بيانات اكثر من عامود في الصفحة الواحدة دون تكرار للكود كما فعلنا في الكود السابق بمعنى بجلب بيانات العمود C والعمود I مباشرة أو حتى أكثر من عمودين ؟؟؟؟ بارك الله فيكم وفي علمكم ... الموضوع هنا بارك الله فيكم

بارك الله فيك أستاذي عبدالعزيز @أبو إبراهيم الغامدي وكتب الله أجرك وأثابك ...... تقبل الله منا ومنكم صالح الاعمال ..... الان اصبحت العملية مفهومه ..... شكرا لك ولجميع أعضاء المنتدى المبارك

ما شاء الله عليك .. كفيت ووفيت . .

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

هلا اخي هذا ليس اجابة عن سؤالك ولكم حبيت اشاركك تصميم مراقبة المخزون (متجر بيع بالتجزئة) Inventory Control (Retail Store) لعلى فيه بعض الافكار http://www.databaseanswers.org/data_models/inventory_control_for_retail/index.htm بالتوفيق

بسم الله مشاء الله عليك اخى العزيز جدااااااا احمد الفلاحجى واضح انك خبرة ( خد بالك هستغلك ان شاء الله ) ☺️ وهصدعك لحد ما اخلص البرنامج ❤️ تبعت الموضوع وردك على الاستاذ سيد ونزلت النماذج واحاول ادرسها وان شاء الله هوفيك بالنتيجة الف مليون شكر ليك يابو حميد

أرجو أن أستطيع غدا إن شاء الله تنفيذ طلبك فأنا مرهق الآن ولا استطيع أن أكمل معذرة

السلام عليكم أي من الحقول الخاصة بالعميل تريد أن يظهر مجموعها Qty أم Qty_sals ومن فضلك وما هي المعادلة الرياضية بين كلا من Qty_sals و Qty و unitPrice فانا أري أرقام غريبة لم استطع معرفة العلاقة بينها

وعليكم السلام اخى @ازهر عبد العزيز بهذه العلامه قبل الكتابه ' وتكتب بحرف الطاء وانت عاتجاه الكتابه الانجليزى Private Sub N1_BeforeUpdate(Cancel As Integer) 'هذا السطر لا ينفذ هو للتعليق If IsNull(DLookup("name", "at", "[serial number]='" & Me.B & "'")) Then MsgBox "هذا النص غير موجود بالجدول" Me.Undo ElseIf DCount("*", "ld", "idlh=" & Me.idlh & "and B='" & Me.N1 & "'") > 0 Then Dim stry As String stry = Me.N1 Me.Undo Dim rs As Object Set rs = Me.Recordset.Clone rs.FindFirst "[B] = '" & stry & "'" If Not rs.EOF Then Me.Bookmark = rs.Bookmark DoCmd.GoToRecord , , acNewRec End If End Sub بالتوفيق

رسالة الخطأ تقول بأنها لم تحصل على الدالة isnothing !! فهل هي موجودة في الكود عندك ؟ او يمكن انك نسخت الكود هذا من برنامج آخر ، ونسيت ان تنسخ الدالة isnothing !! وجدت الدالة هنا : https://www.youtube.com/watch?v=MItoTRM8-kw فنسختها من الفيديو وكتبتها هنا لتسهيل الامر ، لهذا السبب فأنا لا علاقة لي مع الدالة 🙂 اعمل وحدة نمطية جديدة ، ثم احفظ هذه الدالة هناك : Public Function IsNothing(ByVal V) As Integer On Error GoTo nerr IsNothing = True Select Case VarType(V) Case 0 'empty GoTo fext Case 1 'null GoTo fext Case 2, 3, 4, 5, 6 'int, long, single, double, currency If V <> 0 Then IsNothing = False Case 7 'date/time IsNothing = False Case 8 'string If (Len(V) <> 0 And V <> " ") Then IsNothing = False End Select fext: On Error GoTo 0 Exit Function nerr: IsNothing = False Resume fext End Function جعفر

الاستاذ المبدع @أحمد الفلاحجى ماشاء اللة ربي يحفظك روعة عدلت قليلا على مثالك وتم الحل الاستاذ @اشرف شكرا لك ماقصرت ربي يحفظكم من كل سوء

جزاك الله خيرا اخى العزيز @اشرف على مشاركتك اتفضل اخى @ازهر عبد العزيز لديك رقم 3 و 5 بجدول at لا يوجد لهم اسم جرب وجرب رقم اخر من المسجلين ووافنا بالنتيجه ان شاء الله يكون ما طلبت بالتوفيق اخوانى TEST1-azhr.accdb

اتفضل جرب كدة TEST1 (4) - Copy(1).accdb ازهر عبد العزيز

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

جرب التالي TEST (1).accdb

الف شكر ياغالي هل بالامكان تلوين الخط بدل تلوين الحقل كاملا ؟

جرب البرنامج التالي https://www.ssesetup.com/

الاخ العزيز @أحمد الفلاحجى و الاخ العزيز @اشرف شكرا بمروركم العطر

السلام عليكم اخي الفاضل ازهر عبد العزيز اخي الفاضل أحمد الفلاحجى اسمحو لي بالمشاركة هل هذا هو المطلوب ام لم افهم المطلوب TEST1 (4) - Copy(1).accdb

اقدم لكم الشرح المفصل لكيفية حماية برنامجك من الكسر وصد الكراكرز من عملية تكريكة مبدا عمل الحماية تقوم بالتحقق من ، القطع الاتية .. [ MOTHER BORED ID ] - [ CPU ID ] - [ MAC ADDRESS ] - [ HWID ] لم افهم ؟ اعطيك مثال بسيط ، الان انا قمت ببرمجة برنامج واريد اعطاء لشخص اسمه [ احمد ] لكن ! اخاف ان اعطيه البرنامج فيقوم بنشره ، بهذه الطريقة سالجئ لحماية برنامجي على قطع الجهاز الخاصة بـ [ احمد ] المتمثلة بالهاردوير والمذربورد وغيرها [ الادوات المطلوبة / لعمل الحماية ] [ 1 ] برنامج Net. اي اصدار انا طبقت على الاصدار 2012 [ 2 ] حساب بموقع PasteBin.com [ 3 ] مكتبة System.Management [ 4 ] فنكشنات التحقق من قطع الجهاز ، مكتوبة بلغة [ Net. ] اولا نقوم بتسجيل عضوية بموقع [ PasteBin ] رابط التسجيل [ هنا ] اتمام التسجيل ، ظهور رسالة تخبرك بالتوجه نحو بريدك لتفعيل العضوية بعد عملية التفعيل ظهور رسالة تخبرك بنجاح التفعيل الان نقوم بتسجيل الدخول ثم ، نقوم بفتح الفيجوال ستوديو واختيار مشروع جديد ، ثم نقوم باضافة [ TextBox1 ] + [ Button1 ] من قائمة الادوات ليصبح المشروع كالاتي .. الان نقوم باضافة مكتبة الـ [ System.Management] من خيارات المشروع ، كلك يمين ثم نتوجه الى النافذة [ Refernces ] ثم نقوم بكتابة اسم المكتبة في مربع البحث [ System.Mangament ] ثم نضغط موافق الان نقوم بالنقر المزدوج على الـ [ Form1 ] ونقوم بمسح كل الاكواد ونلصق هذه الاكواد Imports System.Management Imports System Imports System.Text Imports System.Security.Cryptography Imports System.Net Public Class Form1 Dim HW As New SEC_Informations Dim HDD As String Dim CPU As String Dim MB As String Dim MAC As String Dim hwid As String = Strings.UCase(HW.getMD5Hash(CPU & HDD & MB & MAC)) Public Class SEC_Informations '..................................... '>> ReCoder : SEMO.Pa3x '>> Skype : Security.Najaf '..................................... Friend Function GetProcessorId() As String Dim strProcessorId As String = String.Empty Dim query As New SelectQuery("Win32_processor") Dim search As New ManagementObjectSearcher(query) Dim info As ManagementObject For Each info In search.Get() strProcessorId = info("processorId").ToString() Next Return strProcessorId End Function Friend Function GetMACAddress() As String Dim mc As ManagementClass = New ManagementClass("Win32_NetworkAdapterConfiguration") Dim moc As ManagementObjectCollection = mc.GetInstances() Dim MACAddress As String = String.Empty For Each mo As ManagementObject In moc If (MACAddress.Equals(String.Empty)) Then If CBool(mo("IPEnabled")) Then MACAddress = mo("MacAddress").ToString() mo.Dispose() End If MACAddress = MACAddress.Replace(":", String.Empty) Next Return MACAddress End Function Friend Function GetVolumeSerial(Optional ByVal strDriveLetter As String = "C") As String Dim disk As ManagementObject = New ManagementObject(String.Format("win32_logicaldisk.deviceid=""{0}:""", strDriveLetter)) disk.Get() Return disk("VolumeSerialNumber").ToString() End Function Friend Function GetMotherBoardID() As String Dim strMotherBoardID As String = String.Empty Dim query As New SelectQuery("Win32_BaseBoard") Dim search As New ManagementObjectSearcher(query) Dim info As ManagementObject For Each info In search.Get() strMotherBoardID = info("SerialNumber").ToString() Next Return strMotherBoardID End Function Friend Function getMD5Hash(ByVal strToHash As String) As String Dim md5Obj As New System.Security.Cryptography.MD5CryptoServiceProvider Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash) bytesToHash = md5Obj.ComputeHash(bytesToHash) Dim strResult As String = "" For Each b As Byte In bytesToHash strResult += b.ToString("x2") Next Return strResult End Function End Class Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load CPU = HW.GetProcessorId() HDD = HW.GetVolumeSerial("C") MB = HW.GetMotherBoardID() MAC = HW.GetMACAddress() TextBox1.Text = (hwid) End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim w As New WebClient Dim cpuids As String() = Split(w.DownloadString("Your Link"), "|") Dim cur As String = hwid For Each c As String In cpuids If cur = c Then GoTo authed End If Next MessageBox.Show("1 - Make sure of the title of [ Hardware ] Is not prohibited" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "2 - Make sure your Internet connection" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "3 - If you find other problems contact on [ Skype : Security.Najaf ]", "Warning message", MessageBoxButtons.OK, MessageBoxIcon.Error) Environment.Exit(0) authed: MessageBox.Show("Has been successfully activated version" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "Thank you for using this program", "Welcome Message", MessageBoxButtons.OK, MessageBoxIcon.Information) End Sub End Class الان نقوم بتشغيل المشروع ، نلاحظ سيظهر لنا رقم طويل نقوم بنسخة ثم نقوم بالذهاب لموقع [ PasteBin ] ونقوم بكتابة مشاركة جديدة نقوم بكتابة الرقم الذي قمنا بنسخه ، مع تعديل خيارات المشاركة ثم نقوم بالضغط على كلك يمين على كلمة [ RAW ] ونختار نقوم بالرجوع لمشروعنا ونستبدل كلمة [ Your Link ] بالرابط الجديد الان قم باعطاء برنامجك للعميل ، وقل له ان يشغله ، بعد ان يقوم العميل بتشغيل البرنامج سيظهر له الرقم الطويل يقوم باعطاءك اياه لتقوم انت بوضعه بالموقع وسيعمل برنامجك بدون اي مشاكل اما عند الاشخاص الغير مصرح لهم باستعمال البرنامج الان السؤال كيف ساقوم باضافة اكثر من رقم عميل بالموقع ؟ الجواب بين كل عميل واخر افصل بينهم بالـ [ | ] مثال بسيط على العملية .. نصائح لحماية معقدة اكثر ، قم بضغط البرنامج بحماية [ SafeEngine ] او [ Consufer ] او غيرها من باقي الحمايات العنيدة .

وعليكم السلام اخى @ازهر عبد العزيز هل هذا ما تريد ؟ جرب ووافنا بالنتيجه بالتوفيق اخى ازهر TEST1 (4) - Copy(1).accdb

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

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

اتفضل ان شاء الله يكون ما تريد ومع اذان المغرب والافطار تقبل الله صيامكم لعل انول دعوه صالحه بالتوفيق اخى 333.mdb

وعليكم السلام 🙂 المشكلة مو في فتح التقرير ، ولا متغيرات ، وانما أمر اغلاق النموذج غير كامل ، لذا يجب ان يكون الامر هكذا : DoCmd.OpenReport "report name", acViewPreview DoCmd.Close acForm, "واجهه البرنامج",acsaveno او الافضل ان لا تذكر اسم النموذج بالاسم ، وانما بمناداة اسمه DoCmd.OpenReport "report name", acViewPreview DoCmd.Close acForm, me.name ,acsaveno جعفر

الرساله بتقول عندك متغيير غير متعرف ممكن تضع مثال لما لديك بالتوفيق

وعليكم السلام 🙂 تم نقاش هذا الموضوع في الرابط التالي ، والذي به رابط آخر كذلك : جعفر

لا اعتقد...في انهاية يعتمد على مدى كفائة كتابة الكود و متانة تصميم القاعدة البيانات و العلاقات بين الجداول و طريقة كتابة الاستعلامات.

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

هل دا هو المطلوب؟ Book01.xlsx

بعد اذن الاخ رائد هذا الملف تم حماية العادلات لعدم التلاعب بها غن طريق الخطأ My_Book5.xlsx

تفضل Book5.xlsx

مثال تطبيقي حول التعامل مع المتصفح: الدخول إلى موقع أوفيسنا في متصفح Internet Explorer من خلال الأكسس المثال التالي يمكننا من إدخال اسم المستخدم و كلمة مرور أوفيسنا و عند الضغط على زر الدخول يفتح الموقع بحسابك الخاص في متصفح أنترنت أكسبلورر Dim HTMLDoc As HTMLDocument Dim oBrowser As InternetExplorer Dim oHTML_Element As IHTMLElement Dim sURL As String On Error GoTo Err_Clear sURL = "https://www.officena.net/ib/login/" Set oBrowser = New InternetExplorer oBrowser.Silent = True oBrowser.Navigate sURL oBrowser.Visible = True Do ' Wait till the Browser is loaded Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE Set HTMLDoc = oBrowser.Document HTMLDoc.all.auth.Value = Me.str_UserName HTMLDoc.all.Password.Value = Me.str_Password HTMLDoc.getElementById("elSignIn_submit").Click ' oBrowser.Refresh ' Refresh If Needed Err_Clear: If Err <> 0 Then 'Debug.Assert Err = 0 Err.Clear Resume Next End If فتح موقع أوفيسنا.rar

يمكن ذلك لكن عليك وضع القائمة المنسدلة بعيداً عن الجدول (العامود A والعامود V لا يصلحان لانهما ملاصقان للجدول انا اخترت العامود X ) كما ذكرت لك ( دون تدخل خلايا غير فارغة على كل حدود الجدول) الماكرو: Sub MY_Test_CHOOS_FILTER() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("DATA") Set sh = Sheets("AS") With Application .Calculation = xlCalculationManual .ScreenUpdating = True End With On Error Resume Next With sh .Range("B2:U1026").Clear ws.Range("B7:U1026").Copy .Range("B2").PasteSpecial xlPasteValues .Columns(5).Replace 0, "" .Columns(5).SpecialCells(4).EntireRow.Delete .Range("B1").CurrentRegion.Sort _ Key1:=sh.Range(Range("X1")), Order1:=1, Header:=1 .Range("M:L").NumberFormat = "d/m/yyyy" End With On Error GoTo 0 With Application .CutCopyMode = False .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Range("B3").CurrentRegion.Borders.Value = 1 Range("B3").CurrentRegion.Offset(1).InsertIndent 1 sh.Range("B1").Select End Sub الملف مرفق Extract_WITH_CHOOSEN_FILTER.xlsb

اسعد الله اوقاتكم ، الكثير من الاشخاص قد تجاوز مرحلة البداية بلغة [ Net. ] وبقي عائما ان صح التعبير اي بقي تائها ويدور حولة سؤال كيف ساطور نفسي ؟ حسنا جدا ، نحن تجاوزنا مرحلة البداية وهي [ دوال التعامل مع الملفات / قراءة / كتابة .. الخ ] وايضا تعلمنا [ دوال التعامل مع الريجستري / قراءة / كتابة / حذف .. الخ ] وايضا التعامل مع العمليات ، و و و ... الخ الان نمر بمرحلة اكثر تطورا وهي مرحلة دراسة دوال الويندوز [ API ] التي هي اختصار لـ [ Application Programming Interfaces ] التي هي بدورها عبارة عن [ نواة ] لكي تساعد على عمل صلة بين برامجنا والنظام .. قبل الخوض في صلب الموضوع ، سنشاهد بعض الدوال تحتاج شيء يسمى [ مقبض ] فما هو ؟ [ مقبض او "Handle" ] و هناك شيء اخر يسمى اجزاء الدالة وتسمى [ Parameter ] اما المقبض او "Handle" فما هو ؟ ببساطة هو اشبه بالمفتاح او الرقم الذي يساعدنا بالتحكم بنافذة معينة ، اي ان لكل نافذة يوجد مفتاح يسمى مقبض للتحكم بها ، لكن!! هذا الرقم او المفتاح يتغير كلما قمنا بغلق البرنامج وتشغيلة مرة اخرى ويستحيل ان نجد لنافذتين عنوان مقبض متشابه ، ملاحظة // نجد دائما اختصار كلمة مقبض بالشكل الاتي [ hWnd ] ، مثال على دالة .. حسنا جدا ... وكيف ساعرف مقبض النوافذ ؟ وكيف ساقوم باستغلاله ؟ قلنا ان المقبض :- هو مفتاح او رقم موجود بكل نافذة للتحكم بها . حمل هذا البرنامج من برمجتي المتواضعه [ هنا ] [ شكل البرنامج ] شرح استخدام البرنامج ، قمت باحضار مقبض نافذة برنامج [ Process Explorer ] حسنا جدا ، تعلمنا ماهو المقبض وكيف نقوم باحضار مقبض اي نافذة نريدها .. من اين ساحصل على دوال [ API ] لتنفيذ مشاريعي ؟ لدينا اهم موقعين [ Pinvoke ] و [ Msdn ] ، حسنا جدا .. دعونا نطبق على موقع [ Pinvoke ] وناخذ دالة ثم نستدعيها .. لاحظو معي الموقع ، الجانب الايسر يحتوي اسماء المكتبات الاساسية التي تحتوي الدوال وبداخل كل مكتبة عشرات الدوال .. مثلا شاهدو الدوال بمكتبة [ User32.dll ] دعونا نختار دالة ونطبق عليها .. اخترنا الدالة [ CloseWindow ] لاحظو كيف ظهرت الدالة بعدة اشكال .. ظهرت بلغة [ #C ] و [ VB.NET ] على اشكال اثنان واحدة مختصرة .. اي كتبت بصورة مختصرة التي تبدا [ Private Declare .. ] نقوم بنسخ الدالة ونلصقها بمشروعنا ، يرجى الانتباه .. سنقوم بادراج الدالة اعلى المشروع اي تحت منطقة [ Public Class Form1 ] لاحظو براميتر الدالة ماذا يحتاج ياترى ؟ ساترك الاجابة لكم .. ننتقل للجزء الثاني كيف نستدعي هذه الدالة ؟ طيب قم باضافة [ Button ] واكتب بداخله اسم الدالة لاحظو معي الاسم .. نكتب [ CloseWindow ] الذي هو اسم الدالة .. ثم نقوم بفتح قوس[ ) ] لاحظو معي الشرح الذي ظهر لي .. اي انه يخبرك بانه يحتاج ان تمرر له مقبض النافذة .. لقد استخرجنا المقبض سابقا ، اذن نقوم باستخدامه ، شاهدو كيف .. الان جرب البرنامج ، واخبرني النتيجة .. الان نقوم بتجربة داله اخرى ولتكن دالة [ SetWindowText ] لانها تستعمل براميتران واحد لتمرير مقبض والثاني لتمرير الاسم الجديد للنافذة .. يحتاج [ hWnd ] ويحتاج [ String ] لاحظو الاستدعاء .. الاول المقبض والثاني الاسم من نوع [ String ] الان جرب المشروع واخبرني النتيجة .. هذا كان شرح مبسط لدوال [ API ] وطريقة استخدامها ، لكي تطور نفسك اقرا مزيدا من الدروس حولها ، ...

اسعد الله مسائكم ايها النخبة ، احببت ان اطرح لكم شرح بسيط جدا في التحكم بـ [ ازرار الكيبورد ] عن طريق دوال الـ [ API ] سيكون الشرح على دالة [ GetKeyPress ] ضمن مكتبة [ user32.dll ] [ GetKeyPress ] للمزيد من المعلومات عنها [ هنا ] ، الان نقوم بكتابة الدالة اسفل الـ [ Public Class Form1 ] Private Declare Function GetKeyPress Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Integer) As Integer لاحظو الدالة تحتوي على براميتر واحد [ Key ] من نوع [ Integer ] الان ركزو معي نقوم باضافة [ Timer ] ثم نغير خاصيته الى [ True ] ثم نكتب بداخله ، الاوامر التالية .. If GetKeyPress(Keys.A) Then MsgBox("I have used the button { A } ") End If If GetKeyPress(Keys.B) Then MsgBox("I have used the button { B } ") End If ماذا فعلنا ؟ لاحظو معي .. If GetKeyPress(Keys.A) Then كتبنا جملة شرطية على الدالة [ GetKeyPress ] ثم مررنا للبراميتر [ Key ] مفتاح [ A ] اختر اي زر يعجبك [ A , B , C , Alt , Shit , F7 , Enter ... ] ثم نقوم بكتابة الشرط الذي نريد تحققه ، عند استخدام الزر المطلوب نحن كتبنا [ A ] فاذا تم الضغط على الزر [ A ] ماذا سيحصل ؟ هذا السؤال يعود لك انت ستحدد الامر الذي تريده ، وعلى سبيل المثال If GetKeyPress(Keys.A) Then MsgBox("I have used the button { A } ") End If اذا تم الضغط على الزر المعين [ A ] سيظهر [ MessageBox ] يخبرك انك استخدمت [ A ] سانتضر تجاربكم وابداعاتكم على استخدام هذه الدالة تم بحمد الله ، SEMO.Pa3x

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

السلام عليكم ___________________.rar