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

تفضل 🙂 1551.Relink.zip

CurrentDb.Properties("StartUpForm")="myForm"

بعد التعديل حسب طلبك. التكرار في اللجان_03.xlsm

كنت مستغرب من ابو البشر يسأل هذا السؤال البسيط ، والآن عرفنا السبب 😁 هل انت متأكد ان اسم النموذج "Form.frm-UserLogon" وليس "Form.frm_UserLogon" او "frm-UserLogon" او "frm_UserLogon" شوف اسم النموذج اذا صحيح

تفضل <>><>< هههههه Relink.rar

انا استعمل Macro اسمه Autoexec والذي معناه انه اول شيء يشتغل عند فتح الاكسس ، وفيها اضع اسم النموذج الذي اريد فتحه ، او الدالة في الوحدة النمطية اللي اريدها تشتغل 🙂 جعفر

السلام عليكم حسب فهمي للموضوع عملت لك بحث في كل الحقول سواء كان في بداية الكلمة او في نهايتها مع معاينة التقرير والذي يمكن طباعته تحياتي العمال.accdb

سأحاول الليلة إن شاء الله فإن وفقت في الحل رفعته لك. مع المعذرة .. حققت لك جزء من طلبك واسمح لي بالتوقف عند هذه النقطة موفقين. التكرار في اللجان_04.xlsm

ما شاء الله تعددت الحلول الاستاذ ابو بسملة فكرة حلوة الأستاذ سامي : جرب تحذف تاريخ من التواريخ الموجودة ثم شغل الفورم انا عدلت على الحقل في الاستعلام فقط fmmm4.rar

وهنا أيضا قمت بعمل كود لإضافة السجلات وترقيمها 🙂 وهذا هو الكود : Sub Add_2000_Record() Dim x As Long For x = 1 To 2000 CurrentDb.Execute "INSERT INTO Ta1 ( IDD ) VALUES (" & x & ");" Next End Sub إضافة2000سجل.rar

جرب هذا المرفق ووافنا بالنتائج اكتب عدد السجلات المطلوبة واضغط علي زر اضافة سجلات فارغة نموذج.rar

اخي العزيز اولا قم بنسخ السجلات من الجدول المطلوب ثانيا ضع المؤشر على علامة النجمة في الجدول ثالثا قم باللصق بشرط تطابق البيانات مع الحقول بالجدول كما في الصورة

أخي مصطفى .. الأكسس يقدم لك طرق سهلة لاستيراد البيانات من مصادر خارجية كالأكسل أو قاعدة أكسس أخرى أو قواعد البيانات الأخرى .. وسائل غير النسخ واللصق 🙂 وكان سؤال المهندس جعفر عن مكان تخزين بيانات هؤلاء ال 2000 موظف لينطلق بك وبنا إلى الوسائل السهلة لاستيراد هذه البيانات لبرنامجك .. 🙂

الدرس الاول في UserForm عناصر الدرس 1- اضافة التبويبات الرئيسية للفورم 2- اضافة MultiPage والتحكم في الانتقالات بينها من خلال التبويبات الرئيسة باستخدام Class Module اولا : اضافة التبويبات الرئيسية 1- نقوم باضة userForm ثم نضيف اطار Frame ونضيف داخله عدد 5 Lebel بالنسبة لعنوان اكتب ما تشاء عربي انجليزي لكن المهم Label Name ( Btn1-Btn2-Btn3-Btn4) ا BackStyle =0 BorderStyle=0 واليبل الخامس لتغير خلفية النص Name=AnlBtn BackColor=&H8000000E& ثم نضيف ليبل خاص بالعنوان نسميه PageNo ثم نضيف MultiPage ونضيف في ال Page1 ثانيا ربط التبويبات بالفورم نضيف Class Module نكتب داخله الكود التالي Public WithEvents LblBtn As MSForms.Label Private Sub LblBtn_Click() ' للحركة بين التبويبات UserForm1.AniBtn.Left = LblBtn.Left 'ربط صفحات المالتي بيج مع التبويبات UserForm1.MultiPage1.Value = Right(LblBtn.Name, 1) - 1 'شريط العنوان UserForm1.PageNo.Caption = "Page No " & UserForm1.MultiPage1.Value + 1 & " ( " & LblBtn.Caption & " )" End Sub وفي الفورم Dim LblEvent(3) As New Class1 Private Sub UserForm_Initialize() With Me.MultiPage1 'لتغير استايل المالتي بيج .Style = fmTabStyleNone: .Value = 0 End With 'عدد التبويبات 4 من صفر الي 3 For AddEvent = 0 To 3 Set LblEvent(AddEvent).LblBtn = Me("Btn" & AddEvent + 1) Next AddEvent End Sub الملف بالمرفقات ياريت ننفذ الخطوات ولو اي استفسار ماتترد اتمني من الله اكون بسط الشرح ويكون فيه الاستفادة مع تحياتي MultiPage Officana.xlsm

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

من تجربتي في الرابط المرفق ، لم استعمل كلمة Form في اسم النموذج . احذفه وجرب ، ووهل جربت تفتح البرنامج مباشرة ، فهل يشتغل دون اخطاء ؟

كنت ولازلت انسان اتعلم وبسيط لا ارتقى الى شريف علمكم بارك الله فيك 😉 نعم لان البرنامج كان يعمل ... ولازال يعمل على اوفيس 2007 ويندوز 7 جهازي حاليا :: ويندوز 10 64Bit اوفيس 19

يا سلام ، هذا الدلع وإلا بلاش 😁

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

جزاك الله اخي @ازهر عبد العزيز اريدة بالكود ..... ليتم تعديله بدون اللجوء لشاشة الخصائص

جزاك الله خير يا اخ احمد Ahmed_J ما قصرت ضبطت معي ... الله يعطيكم العافية

Try this code Sub Test() ExportAsPDF "Cards" End Sub Public Sub ExportAsPDF(ByVal sOut As String) Dim ws As Worksheet, s As String For Each ws In ThisWorkbook.Worksheets If InStr(ws.Name, Chr(199) & Chr(225) & Chr(200) & Chr(216) & Chr(199) & Chr(222) & Chr(201)) Then s = s & IIf(s <> Empty, ",", Empty) & ws.Name Next ws PrintToPDF Split(s, ","), ThisWorkbook.Path & "\" & sOut & ".pdf" End Sub Public Sub PrintToPDF(arr, sFileName As String, Optional vQuality = xlQualityStandard, Optional vIncDocProperties = True, Optional vIgnorePrintAreas = False, Optional vOpenAferPublish = False) ThisWorkbook.Sheets(arr).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, Quality:=vQuality, IncludeDocProperties:=vIncDocProperties, IgnorePrintAreas:=vIgnorePrintAreas, OpenAfterPublish:=vOpenAferPublish ActiveSheet.Select End Sub

شكرا على التوضيح 🙂 انا جربتها على المرفق وضبطت ، فاعتقدت بانها مثل fix 😁

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

بالاضافة لما تفضل به الاستاذ @kkhalifa1960 جزاه الله خيرا اليك مشاركتي Option Compare Database Option Explicit Dim strSQL As String Dim rs As DAO.Recordset Private Sub CmdClear_Click() Me.TEXT_CHERCHE = "" Me.Query_no_subform.Form.Filter = "" Me.Query_no_subform.Form.FilterOn = False End Sub Private Sub TEXT_CHERCHE_Change() strSQL = "numéro_coud LIKE " & Chr(34) & Me.TEXT_CHERCHE.Text & "*" & Chr(34) Me.Query_no_subform.Form.Filter = strSQL Me.Query_no_subform.Form.FilterOn = True Set rs = Me.Query_no_subform.Form.Recordset If (rs.RecordCount <> 0) Then rs.MoveFirst Do Until rs.EOF rs.Edit rs![oui/non] = True ' change "chkBoxFieldName" with the actual name of your checkbox field rs![date_à_regler] = Date ' change "dateFieldName" with the actual name of your date field rs.Update rs.MoveNext Loop Else MsgBox "السجل المطلوب تم التحقق منه سابقا بتاريخ " End If End Sub Private Sub cmdPrintPreview_Click() Me.TEXT_CHERCHE.SetFocus strSQL = "numéro_coud LIKE " & Chr(34) & Me.TEXT_CHERCHE.Text & "*" & Chr(34) ' Open the report in print preview mode DoCmd.OpenReport "MyReport", acViewPreview, , strSQL End Sub وهذا ملفك بعد التعديل. هل هو المطلوب؟ بالتوفيق my PR.accdb

شكرا ابو احمد على المعلومة ، واتضح ان Int يصلح كذلك 🙂 int([DateTime]) او fix([DateTime])

هل ممكن ان ترفق ملفك حتى نرى اين المشكلة ؟ وجرب هذا التعديل Private Sub Form_Load() Dim OldLong As Long Dim nodX As Node Set nodX = TreeView1.Nodes.ADD(, , "R", "أعدادات النظام", 3) Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C1", "بيانات الشركة", 2) Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C2", "بيانات مستخدمي النظام", 5) Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C3", "كلمات المرور", 1) Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C4", "بيانات المطورين", 4) nodX.EnsureVisible OldLong = GetWindowLong(TreeView1.hwnd, GWL_EXSTYLE) SetWindowLong TreeView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL InvalidateRect hwnd, 0, False Dim formsDictionary As New Scripting.Dictionary formsDictionary.ADD ChrW(&H62A), "frmCompany" formsDictionary.ADD ChrW(&H622), "frmSystemUserData" formsDictionary.ADD ChrW(&H643), "frmPassword" formsDictionary.ADD ChrW(&H62C), "frmDeveloper" End Sub Private Sub TreeView1_Click() Dim strFormName As String Dim formsDictionary As New Scripting.Dictionary formsDictionary.ADD "بيانات الشركة", "frmCompany" formsDictionary.ADD "بيانات مستخدمي النظام", "frmSystemUserData" formsDictionary.ADD "كلمات المرور", "frmPassword" formsDictionary.ADD "بيانات المطورين", "frmDeveloper" strFormName = TreeView1.SelectedItem.Text If formsDictionary.Exists(strFormName) Then DoCmd.OpenForm formsDictionary(strFormName) Else MsgBox "عذرا هذا النموذج غير موجود", vbExclamation, "تنبيه" End If End Sub ولك بمثل ما دعوت أخي الدكتور محمد تحياتي

ويمكن استحصال التاريخ فقط باستخدام دالة Fix أيضا.

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

إذا هذا هو الشهر الذي نبحث عنه استاذنا @ابوخليل وانا - واعوذ بالله من كلمة انا- اتيت بها يا رجل - جزاك الله خيرا

الحقيقة العملية معقدة وصعب عملها بالتنسيق الشرطي. سأقوم ابتداءً بعمل كود يبحث عن التكرار ويتوقف مع أول تكرار حتى تقوم بتصحيح التكرار ثم تبحث من جديد.

تفضل أخي ووافني بالرد 1585909217_myPR-1.accdb

وطريقة اخرى للنسخ واللصق ، في الاكسل مثلا ، نظم الحقول بنفس ترتيب الحقول في الاكسس ، او في الاكسس نظم الحقول بنفس ترتيبها في الاكسل (يعني امسك الحقل و خليه يزحف يمين ويسار) ، ومو لازم جميع الحقول تكون متساوية في الاكسل والاكسس ، في الاكسل اعمل نسخ للاعمدة المطلوبة ، وفي الاكسس اختار في سجل جديد (مكان وجود النجمة) ، ثم اختار الحقول المتسلسلة من الاكسس (يعني مو كل الحقول) ، ثم الصق 🙂 وعلشان ترتيب الحقول في الجدول ما تخترب عليك ، اغلق الجدول بدون ان تعمل له حفظ : . جعفر

وعليكم السلام ورحمة الله تفضلtest.xlsm

اريدك تتمعن في طريقة عرض وتنسيق ومحاذاة الاكسس لبيانات الحقول ، وهو نفس التنسيق سواء للجداول او الاستعلام او النماذج او التقرير في الصورة التالية ، ترى جزء من بيانات الجدول ، وتحته 3 طرق لعرض التاريخ في الاستعلام : . من تنسيق/محاذاة القيم في الجدول ستعرف محاذاة التاريخ الصحيحة (نفس الشئ ينطبق على حقل النص او التاريخ او الرقم) ، فالمفروض تعرف اي الطرق الثلاثة من الاستعلام صحيحة 🙂 . . جعفر New Microsoft Access Database.zip

تم حذف السطر الاول من ملف الاكسس بواسطة كود من الاكسس وهذا هو الكود. Sub DeleteFirstRow() Dim xlApp As Excel.Application Set xlApp = New Excel.Application Dim xlWorkbook As Excel.Workbook Set xlWorkbook = xlApp.Workbooks.Open("C:\xxxxx\0125.xls")غير مسار الملف xlWorkbook.Sheets(1).Activate Dim firstRow As Excel.Range Set firstRow = xlApp.ActiveSheet.Range("A1:IV1") firstRow.Delete xlWorkbook.Save xlWorkbook.Close xlApp.Quit End Sub بالتوفيق

السلام عليكم 🙂 اخوي ابو البشر ، الافضل ان تحذف الرابط الحالي قبل ان تعمل رابط جديد ، وتتعامل مع النسخة xlsx 🙂 If tdf.Name = "shet_Data" Then Call CurrentDb.TableDefs.Delete(tdf.Name) DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12Xml, _ "shet_Data", CurrentProject.Path & "\Data.xlsx", True, "ورقة1$" End If جعفر

السلام عليكم ورحمه الله وبركاته وبها نبدأ 1- مرحبا بك في المتتدي وفي المشاركه الاولي لك في المنتدي 2- هذا الموضوع يخالف قواعد المنتدي 3- ان كان باسوورد فتح الملف من الصعب معرفته

يبدو ان طريقتك اسرع وأخصر لأن كلمة PrimaryKey لا معنى لها ، جرب اكتب اسمك او شيء بدلها سوف يعمل الكود ولكن اذا وضعت اسم الحقل بدلا منها فسوف يتم فحصه فان كان مفهرسا يطالبك بازالة الفهرسة اولا .

وعليكم السلام ورحمة الله تعالى وبركاته تقضل استاد فوزي ربما هدا ما تقصد Const MyWidth As Single = 80 Const MyHight As Single = 20 Private Sub TEST1() Dim WS As Range Dim Lf As Double, Tp As Double Dim ContColmn As Integer, r As Integer, c As Integer Set WS = Range("A3:I17") ContColmn = WS.Columns.Count For r = 1 To WS.Rows.Count l = 0 Lf = Me.Frame1.Width - 100 For c = 1 To ContColmn Lf = Lf - WS.Columns(c).Width With Me.Frame1.Controls.Add("Forms.Label.1") .BorderStyle = 1 .Move Lf, Tp, MyWidth, MyHight .Width = WS.Columns(c).Width Call TEST(.Name, WS.Cells(r, c)) End With Next Tp = Tp + MyHight c = 0 Next Set X = Nothing End Sub Private Sub TEST(iName As String, MyCel As Range) With Me.Controls(iName) .BackColor = MyCel.Interior.Color .Caption = MyCel.Text .TextAlign = 2 With .Font .Name = MyCel.Font.Name .Bold = True .Size = MyCel.Font.Size End With End With End Sub Private Sub UserForm_Initialize() Me.Frame1.SpecialEffect = 0 TEST1 End Sub عرض النتائج فى الفورم_1.xlsm

السلام عليكم الخلل كان في تنسيقات الصفحة (ناحية الطباعة-تحجيم الصفحة-فاصل الصفحات..) وقد تم تعديلها... الملف.rar

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

بارك الله فيك أستاذ ضاحى وبالتوفيق دائماً

وعليكم السلام -على الرغم من كثرة طلباتك !!! - تفضل لك ما طلبت جدول 1المباريات.xlsx

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

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

تفضل EXEMPLE.xlsm

المرفق به فورم يحتوي على عدد 2 ليست بوكس احدهما لجلب اسماء الاوراق الموجودة في ملف الاكسيل يوجد ازرار تمكنك من ترحيل اسماء الاوراق التي تريد طباعتها او حفظها إلى الليست بوكس الاخر ومن ثم الضغط على زر الطباعة او الحفظ يمكنك اكتشاف الامر عمليا حمل المرفق وشاهد Print and Save As pdf Using ListBox in a UserForm.rar

السلام عليكم ورحمة الله تم تعديل آخر على الملف... حيث قمت بالاستعانة بالنطاقات بالتسمية المطاطة للبيانات المرحلة سميتها Tarhil (نطاق يحوي فقط صفوف البيانات المرحلة غير الفارغة)... أرجو أن يفي هذه المرة الغرض المطلوب... بن علية تعديل الاستاذ بن علية.rar

السلام عليكم الشكر واصل لاخي ابوحنين تم فرز البيانات حسب عمود الاسم بعد مسح الخلايا التي لا توجد فيها معادلات Sub trheel() Dim cel As Range Dim Lr As Long, Lrr As Long, R As Long, i As Long, iCont As Long With Sheets("البيانات") Lr = .Cells(Rows.Count, "B").End(xlUp).Row iCont = WorksheetFunction.Max(.Range("A3").Resize(Lr)) Lrr = Cells(Rows.Count, "D").End(xlUp).Row For R = 3 To Lrr If Cells(R, "O").Value = "ناجح" Then i = i + 1 .Cells(Lr + i, "A").Value = iCont + i .Cells(Lr + i, "B").Resize(1, 13).Value = Cells(R, "B").Resize(1, 13).Value .Cells(Lr + i, "O").Value = [I1] .Cells(Lr + i, "P").Value = [M1] If cel Is Nothing Then Set cel = Cells(R, "A").Resize(1, 13) Else Set cel = Union(cel, Cells(R, "A").Resize(1, 13)) End If Next End With If i Then On Error Resume Next cel.SpecialCells(xlCellTypeConstants).ClearContents On Error GoTo 0 With Range("A3:M" & Lrr) .Sort .Columns(4), xlAscending End With End If Set cel = Nothing End Sub تحياتي