أبو إبراهيم الغامدي

أهلا بكم..
لكن كيف تقوم الأداة بتخزين البيانات في حقل مصدر التحكم؟ وأيضا ماذا لو كان النموذج غير مرتبط بمصدر بيانات؟ هذه الأسئلة لا يمكن تجاهل الإجابة عنها!!
عندما واجهت أبا جودي مشكلة عدم تطابق البيانات، قام بفحص البيانات العائدة من صندوق التحرير والسرد بالتابع TypeName، ليتفاجأ أن البيانات العائدة من نوع (متعدد، متنوع)!
فلماذا لم يقبل صندوق الرسائل عرض البيانات كنص؟!
السبب في ذلك أن البيانات العائدة وإن كانت من النوع (متنوع)، إلا أنها على هيئة مصفوفة بيانات! ومصفوفة البيانات أفرادها من النوع (متنوع).
وكان الأولى فحصها البيانات العائدة من صندوق التحرير والسرد بالتايع VarType. يعيد هذا التابع رقما يشير إلى نوع البيانات كما هو مبين في الرابط التالي: VarType function
 
بعد معرفة أن البيانات العائدة من صندوق التحرير والسرد هي مصفوفة بيانات؛ كيف يمكن قراتها جميعا دون الحاجة إلى عمل دوارة For... Next؟ 
يمكن استخدام التابع Join  لهذا الغرض..
Private Sub cmdRequired_Click() Debug.Print VarType(cboEmpSection.Value) 'تعيدالرقم 8204، انظرالاقتباس أعلاه MsgBox Join(cboEmpSection.Value, ", ") ' يمكن استخدام محدد الفصل Debug.Print Join(cboEmpSection.Value) ' يمكن تجاهل محدد الفصل End Sub  

هناك طريقة أخرى؛ وهي أن نجعل الصفوف المطابقة للبحث تظهر ملونة في الأعلى، وغير المطابقة تظهر غير ملونة في الأسفل..
أرجو أن تكون هذه الفكرة مرضية لك..
 

 
SearchIn HTML Table.accdb

أهلا بك..
يمكن استخدام الشفرة التالية في حدث النموذج KeyDown
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Static I As Integer, PgCnt As Integer PgCnt = Me.MyTabs.Pages.Count - 1 Select Case KeyCode Case Is = 34 If I <= 0 Then Me.MyTabs = 0 Else I = I - 1 Me.MyTabs = I End If Case Is = 33 If I >= PgCnt Then Me.MyTabs = PgCnt Else I = I + 1 Me.MyTabs = I End If End Select Debug.Print KeyCode End Sub TabCtrlNav.zip

أهلا محمد.. آسف على عدم الاهتمام
إليك ما طلبت
كهربا (1).mdb

أهلا @محمد احمد لطفى
أرجو لك مزيدا من التقدم والتوفيق..
إليك التعديل
تعليمى (1).mdb
 

استخدم الشفرة التالية في زر الأمر START
Dim I As Integer Dim DATE_POST As Date DATE_POST = CDate(Forms![TEST1]![Date_M]) For I = 1 To Forms![TEST1]![F] If Not Weekday(DATE_POST) Like "[6-7]" Then Me.no = I Me.date = DATE_POST Else I = I - 1 End If DATE_POST = DATE_POST + 1 DoCmd.GoToRecord , , acNewRec Next  

إن شاء الله لن أخيبك، وسوف أعمل على هذا ما اتسع له وقت..
عند الرجوع إلى المشاركة التي جاء منها المثال؛ وجدت أني سبق وعملت على عارض الصور، فقمت بتحسين عرض الصور وبرمجة النموذج المنبثق.. لكني لست راضيا عن هذا العمل..
سوف أقوم في قابل الأيام؛ بعد توفيق الله ومشيئته بتحسن العمل لكي يعمل على مستعرض الويب بالكامل..
Photo.zip 
 

أهلا بك @محمد احمد لطفى
لم استخدم لغة أخرى!
إليك التعديل: Photo.zip

أهلا @محمد احمد لطفى
الشفرة التالية تفي بالغرض إن شاء الله..
Private Sub أمر0_Click() On Error GoTo ERR_CODES Dim HTML_FILE_NAME As String Dim HTML_TITLE As String Dim TABLE_NAME As String Dim SQL As String '-- ASSIGNING VALUES TO SQL STATMENT VARIABLES Const HTML_SPECIFICATION As String = " [HTML IMPORT;HDR=YES;] " HTML_FILE_NAME = CurrentProject.Path & "\" & "0125.HTML" '.. THE HTML FILE IS THE DATABASE HTML_TITLE = "0125" '.. THE HTML TABLE NAME IS THE HTML TITLE CREATE_TABLE_SQL: '-- ASSIGNING TABLE NAME USING INPUTBOX TABLE_NAME = InputBox(Err.Description & " Plase Enter New Table Name.", _ "New Table Name", , Me.WindowWidth / 2, Me.WindowHeight / 2) If Len(TABLE_NAME) = 0 Then GoTo EXIT_SUB End If '-- CREATE SQL STATMENT SQL = "" SQL = SQL & " SELECT * INTO " & TABLE_NAME SQL = SQL & " FROM " & HTML_TITLE SQL = SQL & " IN'" & HTML_FILE_NAME & "'" SQL = SQL & HTML_SPECIFICATION '-- EXECUTE SQL STATEMENT TO CREATE TABLE CurrentDb.Execute SQL Application.RefreshDatabaseWindow EXIT_SUB: Exit Sub ERR_CODES: If Err.Number = 3010 Then GoTo CREATE_TABLE_SQL Else MsgBox Err.Number & vbNewLine & Err.Description End If End Sub IMPORT_HTML_TABLE.zip

وعليكم السلام رحمة الله 
أهلا بك @النجاشي
أجريت تعديلا على بعض الإجراءات..
وأنشأت لك وظيفة تقوم بالبحث عن اسم الملف أبتداءً من الدليل الرئيسي إلى أدنى مستوىً من الأدلة الفرعية. فإن كان الملف موجودا؛ أعادة اسم الملف مع الدليل..
الوظيفة مع التعديلات
Public Function XPath() XPath = CurrentProject.Path & "\src\" End Function Public Function FSO() As FileSystemObject Set FSO = New FileSystemObject End Function Public Function GetFileDirectory(MainPath As Object, Optional FileName As Variant) Dim OFIL As Scripting.File, OFILS As Scripting.Files Dim OMFD As Scripting.Folder, OSFD As Scripting.Folder Static XFileName As String, FilePath '.. Static Declaration reserved value when function recoll '-- get filename in first time call and reserved value If Not IsMissing(FileName) Then XFileName = FileName End If '-- loop for subfolders in his parent folder For Each OSFD In MainPath.SubFolders Set OMFD = FSO.GetFolder(OSFD.Path) Set OFILS = OSFD.Files '-- loop for file in each folder For Each OFIL In OFILS If OFIL.Name = XFileName Then FilePath = OFIL.Path GoTo TheEnd End If Next '-- Function recoll himself with subfolder GetFileDirectory OSFD Next TheEnd: '-- Function return filepath if file found GetFileDirectory = FilePath End Function  
اظهار المرفقات .zip

وعليكم السلام ورحمة الله وبركاته
أهلا @محمد احمد لطفى
Sub FillWebData() On Error Resume Next Dim F As HTMLFormElement Set F = WD.Forms("aspnetform") F("ctl00$Main$txtMain").Value = Me.Parent("حساب") F("ctl00$Main$txtName").Value = Me.Parent("الاسم") If WD.querySelectorAll("#ctl00_HeadContent_handasa > option").Length = 0 Then F("ctl00_HeadContent_governmentCMB").Value = "1" F("ctl00_HeadContent_governmentCMB").OnChange End If F("ctl00$Main$txtCurrentRead").Value = Me("حالية") F("ctl00$Main$txtDay").Value = Me.Parent("يومية") F("ctl00$Main$txtNationalID").Value = Me.Parent("IDPerson") F("ctl00$Main$txtManteka").Value = Me.Parent("منطقة") F("ctl00$Main$txtFary").Value = Me.Parent("فرعى") F("ctl00$Main$txtPhone").Value = Me.Parent("mobile") F("ctl00$Main$txtEmail").Value = Me.Parent("email") ' ctl00$HeadContent$tel '-- Solution of handasa field Do Until SetValue(WD, "461"): DoEvents: Loop '----------------------------- End Sub Sub DisplayFatorah() On Error Resume Next Dim F As HTMLFormElement Set F = WD1.Forms("aspnetform") F("ctl00_HeadContent_DropDownList2").Value = "1" If WD1.querySelectorAll("#ctl00_HeadContent_DropDownList1 > option").Length = 0 Then F("ctl00_HeadContent_governmentCMB").Value = "1" F("ctl00_HeadContent_governmentCMB").OnChange End If F("ctl00$Main$txtManteka").Value = Me.Parent("منطقة") F("ctl00$Main$txtDay").Value = Me.Parent("يومية") F("ctl00$Main$txtMain").Value = Me.Parent("حساب") F("ctl00$Main$txtFary").Value = Me.Parent("فرعى") '-- Solution of handasa field Do Until SetValue(WD1, "461"): DoEvents: Loop '----------------------------- End Sub غير اسم النموذج في كلا الإجرائين إلى Forms("form1") بدلا من Forms("aspnetform")

للتذكير فقط .. سهلة! 
finish (5).mdb
 

للتذكير فقط .. سهلة! 
finish (5).mdb
 

وعليكِ السلام ورحمة الله وبركاته
لنقم بتغيير طريقة السؤال على النحو التالي..
ماهو المبلغ الذي إذا أضفنا عليه الضريبة (%15) صار (1000)؟
وللإجابة على هذا السؤال؛ يجب أن نفهم أنه لا يمكن أن نضرب النسبة المجردة (0.15) في (1000) لسببين
الأول أن هذه العملية تعيد (%15) بالنسبة إلى (1000) وليس إلى المبلغ المطلوب إضافة النسبة إليه ليصبح ألفا..
الثاني أن ناتج هذه العملية يعيد مبلغ النسبة إلى الأف، وحاصله (150). وهنا لا يمكن بتاتا  القول أن المبلغ المطلوب هو (1000-150)! هذا فضيع..
 إذا ماذا نعمل؟! وكيف نجيب على السؤال؟!
في العمليات المحاسبية لا نستخدم النسبة المجردة (0.15) بل نستخدم (1.15)!
إذا أردنا أن نعيد مبلغ 1000 مضافاً إليه ضرييبة %15 فستكون العملية الحسابية: 1000*1.15  
إذا أردنا أن نعرف المبلغ الذي إذا أضفنا إليه %15 صار 1000 فستكون العملية الحسابية: 1.15/1000

أرجو أن تكون الفكرة وصلت!

وعليكم السلام ورحمة الله و بركاته
يمكن وضع هذه القيمة في المحدد الأخير لتابع فتح التقرير
Dim stDocName As String stDocName = "Q1" DoCmd.OpenReport stDocName, acViewPreview, , , , 16000 '** يمكن أخذ القيمة من مربع نص وفي التقرير في خدث عند الفتح أضف النص التالي في الأعلى
Private Sub Report_Open(Cancel As Integer) Dim Allrecords As Integer If Not IsNull(Me.OpenArgs) Then Allrecords = Me.OpenArgs End If

نعم يمكن بشرط أن تكون المتصفح هو محرك ChromeDriver، بمعنى أنه يقلع من خلال أكسس..
تعليمى.mdb
 

أهلا @محمد احمد لطفى
لا يخفى أن مستندات هتشمل HTML مبنية على وسوم مترابطة هرمياً، وأن لهذه الوسوم رتب في هذا الهرم، وهي الآباء والأبناء والإخوة، وهذه الرتب قد تتداخل في بعضها البعض..
والمقصود من هذه التقدمة هو تسهيل الوصول إلى البييانات المضمنة داخل هذه الوسوم بطريق سهلة ومبسطة..
يمكن الوصول إلى البيانات بأحد الخصائص التالية
Dim Tag,Class,Name,Id With WebBrowser1.Document ' أكثر هذه الخصائص تحديد Id=.getElementById("...") ' أقلها اتساعا وأقربها تحديدا For Each Name in .getElementsByName("...") Name Next ' تتوسع أفقيا أي في رتبة الأخوة For Each Class in .getElementsByClassName("...") Class Next ' أكثرها إنتشار For Each Tag in .getElementsByTagName("...") Tag Next end with أغلب هذه الخصائص تعيد مصفوفة غرضية ماعدا الأولى منها... 
نأتي على تطبق هذا على قاعدة البيانات 
Private Sub أمر11_Click() Dim el As IHTMLElement Dim t For Each el In WD.getElementsByClassName("spaceit_pad") t = Split(el.innerText, ":") Select Case t(0) Case "score" Me.Score = t(1) Case "rating" Me.Rating = t(1) Case "genres" Me.Genres = t(1) Case "theme" Me.Theme = t(1) End Select Next End Sub  
 أرجو أن يكون بإمكانكم اكتشاف طريقة معالجة البيانات..
 
 

وعليكم السلام ورحمة الله وبركاته
أهلا @عبد الله قدور
استخدم التابع FormatNumber بهذه الطريقة
FromatNumber(15.5,0)  

أهلا بك أبو العقاب
راجع المرفق التالي.. أرجو أن يكون مناسبا لمتطلباتك
الحدود وضعت من أجل التصميم.. يمكنك إزالتها بتعديل خصائص لون الحدود إلى (شفاف)
استخدمت الخطوط عوضا عن عنصر ActiveX
طباعة ملصقات نهائي.zip

أهلا بكم..
حسب معرفتي أن أجهزة المسح لها إعدادت انتقال مثل(ENTER, TAB, SPACEBAR) وغيرها من طرق الإدخال يتم برمجة الجهاز عن طريق مصورات (باركود) متوفرة في دليل الاستخدام
إذا لم  يكن دليل الاستخدام متوفر لديك أو كانت هذه الرموز غير متوفرة ضمن الدليل فيمكنك زيارة موقع الشركة للاطلاع على التعليمات المساندة..
 

وعليكم السلام محمد..
الملفات الثنائية لها معرفات نصية في أول سطر من الملف! يمكن الاستفادة من هذه الميزة للتعرف على الملف الأصلي حتى لو غُيرت اللاحقة!
افتح الملف بواسطة محرر النصوص التقليدي للحصول على معرف الملف ثم استخدم هذا المعرف في فحص القيمة..
في أكسس الشفرة التالية تفي بالغرض إن شاء الله
Sub TestData() On Error Resume Next Dim fn, ft fn = CurrentProject.Path & "\testdata\testdata.msi" Open fn For Input Access Read As #1 Line Input #1, ft Close #1 If ft Like "*Standard ACE DB*" Then Name fn As Replace(fn, ".msi", ".accdb") End If End Sub  

أهلا يك أ. عطا
عن طريق زر الأمر لا أعتقد..
لكن إذا كنت تستخدم أكسس 2007 فما فوق.. يمكن أن يكون الحل في المرفق مقبولا..
azizz.accdb

أهلا بكم..
لجعل الأمور أكثر سهولة ومرونة للمبتدئين.. 
الشفرة التالية تفي بالغرض!
Option Compare Database Option Explicit Dim xp As Single, yp As Single '-- أخذ النقطة الأولية للفارة وإسنادها إلى متغير عام '-- بهذه االطريقة يمكن قبض النافذة من أي نقطة دون الشعور بعدم التركيز Private Sub FormHeader_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) xp = X yp = Y End Sub Private Sub FormHeader_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim l, t If Button = acLeftButton Then l = Me.WindowLeft + X - xp t = Me.WindowTop + Y - yp Me.Move l, t End If End Sub أو هذه أيضا
'-- هذه الطريقة تتماشى مع سلوك المستخدم '-- أغلب المستخدمين يقبض النافذة من المنتصف '-- الشعور بعدم التركيز لا يكاد يلحظ Private Sub FormHeader_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim l, t If Button = acLeftButton Then l = (Me.WindowLeft + X) -(Me.WindowWidth/2) t = (Me.WindowTop + Y) - (Me.FormHeader.Height/2) Me.Move l, t End If End Sub  
Database1.accdb

جرب نسخة 2003 من المرجح أنها تعمل!
Import Data from oracle Report.zip

أعتذر عن هذا الخطأ
Import Data from oracle Report.zip