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

وهذي مشاركتي مع اخونا @Hawiii مجرد فكرة Nouveau Microsoft Access Database.accdb ما اقدر اقول غير انك فناااااان ماشاء الله عليك

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

ممكن وباكثر من طريقة ولكن الاسهل استخدام in If IsNull(tx3) Then MsgBox "فضلا اكتب رقم الموظف", , "تنبية": Exit Sub Dim k, w As String k = Me.tx3 & "," w = "table.id IN (" & Left$(k, Len(k)) & ")" DoCmd.OpenReport "r_1", acViewPreview, , w الملف مرفق test_bar.accdb

جرب محاولتي ، نقر مزدوج على حقول أي سجل سيفتح لك نموذج آخر بالتفاصيل. تم تبديل المرفق حيث كان يخفق في الحساب حينما يكون شهر النهاية هو نفسه شهر البداية. VacationDetails_Hawiii_02.accdb

تفضل المفتاح العلوي سنقلك للسجل السابق و يضع التركيز على حقل التاريخ Private Sub Form_Open(Cancel As Integer) On Error Resume Next Me.KeyPreview = True End Sub Private Sub form_KeyDown(KeyCode As Integer, Shift As Integer) On Error Resume Next Select Case KeyCode Case vbKeyUp DoCmd.GoToRecord , , acPrevious db.SetFocus End Select End Sub d11.accdb

يمكنك استعمال هذا الشرط ضع في المصفوفة shArr اسماء الشيتات التي ترغب البحث فيها وغير كود for each x الى shArr = array("sheet1","sheet2","sheet3") For Each x In ThisWorkbook.Worksheets if UBound(Filter(shArr, x.name)) > -1 then ss = x.Cells(Rows.Count, 2).End(xlUp).Row For Each C In x.Range("c3:c" & ss) b = InStr(C, TextBox19) If b > 0 Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(C.Row, 1).Value ListBox1.List(k, 1) = x.Cells(C.Row, 2).Value ListBox1.List(k, 2) = x.Cells(C.Row, 3).Value ListBox1.List(k, 3) = x.Cells(C.Row, 4).Value ListBox1.List(k, 4) = x.Cells(C.Row, 5).Value ListBox1.List(k, 5) = x.Cells(C.Row, 6).Value ListBox1.List(k, 6) = x.Cells(C.Row, 7).Value ListBox1.List(k, 7) = x.Cells(C.Row, 8).Value ListBox1.List(k, 8) = x.Cells(C.Row, 9).Value ListBox1.List(k, 9) = x.Cells(C.Row, 10).Value ListBox1.List(k, 10) = x.Cells(C.Row, 11).Value ListBox1.List(k, 11) = x.Cells(C.Row, 12).Value ListBox1.List(k, 12) = x.Cells(C.Row, 13).Value ListBox1.List(k, 13) = x.Cells(C.Row, 14).Value ListBox1.List(k, 14) = x.Cells(C.Row, 15).Value ListBox1.List(k, 15) = x.Cells(C.Row, 16).Value ListBox1.List(k, 16) = x.Cells(C.Row, 17).Value ListBox1.List(k, 17) = x.Cells(C.Row, 18).Value k = k + 1 End If Next C end if Next x بالتوفيق

السلام عليكم عند الاستيراد اضفط زر استعراض اولاً ثم خدد الملف واضغط زر استيراد وعند التصدير استخدم الكود التالي On Error GoTo err: DoCmd.OutputTo acOutputTable, "tbl_Items", acFormatXLSX, , False MsgBox "أكسس صدر البيانات المطلوبة إلى ملف إكسل بنجاح" err: MsgBox "مشكلة بتصدير الملف" DATA10041.mdb تحياتي

في حدث عند الفتح ضع الكود التالي مع اضافة مسار كل ملف داخل الكود Dim strFilename As String: strFilename = "ضع هنا مسار الملف" Dim strTextLine As String Dim iFile As Integer: iFile = FreeFile Open strFilename For Input As #iFile Do Until EOF(1) Line Input #1, strTextLine [ComoboBox1].AddItem strTextLine Loop Close #iFile

السلام عليكم و رحمة الله و بركاته هام جدا لكل مهتم الرجاء منح الموضع وقتك إن كانت لك القدرات و رغبت الفائدة المادية اخوتي الأكارم أساتذتي الرائعين من سنوات طويلة و انا عضو في اوفيسنا لم تتسنى لي المشاركة بشكل فعال بسبب ظروف بلدي و بالتالي ظروفي اسمي حبيب درويش من سوريا و اعيش الان في سويسرا درست العلوم المصرفية في سوريا و نظم المعلومات في الادارة و المحاسبة و الاقتصاد كنت مديرا ماليا لشركة اجنبية في سوريا و ثم مستشارا لشركة محلية و صاحب شركة قبل ما جرى في سوريا عندما هاجرت و اردت البداية في سويسرا تفاجئت داخل سوق العمل السويسري بانهم لا يمتلكون قوة البرامج العامة التي نمتلكها في بلادنا و بالتالي الفرص متاحة بشكل قوي جدا لإنشاء مشاريع مربحة جدا نستثمر بها خبراتنا و حماسنا و اصرارنا و عزيمتنا الفكرة انشاء فريق برمجي - لغوي - تسويقي - اداري للعمل على تحقيق عدة مشاريع بعد دراسة للسوق بشكل جيد النقاط الايجابية وسط اوربا - قيمة شرائية عالية للعملة في هذا البلد مقارنة مع باقي العالم ما نحتاج اليه فريق برمجة لغات للكمبيوتر فريق برمجة تطبيقات للموبايل خبراء سيرفرات محاسبين صدقا بالله نستطيع انشاء فرق عمل كاملة تستفيد و تستنفع في بلداننا و يكون عملنا منافس جدا بسبب فارق النقد بين البلدان اتطلع لنقاش هذا اخوتي الكبار في الموقع اصحاب الموقع ارجو منكم أخذ الموضع على محل الجد هنا مثال لما يمكن انجازه https://office.bexio.com/

حسب علمي قارىء الباركود لا يقرأ اقل من 3 خانات بمعنى انه لا يقرأ الباركود المكون من رقم او رقمين وينطبق هذا على الحروف

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

الف شكر و تحياتي أستاذنا

رائع جدا تطبيقك للفكرة ويمكنك استعمال هذا الكود فقط في النموذج Private Sub UserForm_Activate() minutes = 0.1 For a = 1 To 100 timer_avant = Timer Do While Timer < timer_avant + minutes DoEvents Me.Im1.Width = a * 474 / 100 Me.Nour1.Caption = a Loop Next Me.Hide End Sub لاحظ التغيير في عرض التسمية im1.width حيث 474 هو العرض الأساسي للتسمية ونحن قسمنا 474 على 100 ثم ضربنا في a لنحصل على العرض الكامل في نهاية العداد a بالتوفيق

أ محمد صالح السلام عليكم و الله أنا قمت بمحاولة ممكن تعدل على الكود لكي يتماشى مع الprogress و تصحح لو فيه خلل و شكرا مسبقا Classeur1111.xlsm

جزاك الله خير ونفع الله بعلمك واسف على الإزعاج

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

ما شاء الله تبارك الله ..... معلم يا استاذ @kha9009lid >>>>

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

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

بعد إذن أخي محمد ابو عبد الله وإذا كنت تريد التصدير لنفس الملف يمكنك استبدال هذا السطر في كود التصدير ExpEX = CurrentProject.Path & "\" & "tbl_Items.XLSX" بالتالي ExpEX = Me.FilePath.Value طبعا بشرط أن يتم تحديد الملف بزر استعراض اولا والا يكون اسم الملف فارغا بالتوفيق

العين ما تعلى على الحاجب أخي العزيز

اتعب و انا اقول فناااان ماشاء الله عليك شغل جدا جميل و احترافي و مرتب

2الجبلاوى الأمر فى غاية البساطة لأنك لم تقم بالضغط على ctrl+Shift+Enter بعد كتابة وصياغة المعادلة فهذه ليست معادلة عادية ولكنها معادلة مصفوفة

تفضل الكود و التعديل On Error Resume Next Dim MyFile, DstFile As String Dim Syso As Object Dim db As DAO.Database Dim rs As DAO.Recordset '==================================== Set rs = CurrentDb.OpenRecordset("SELECT * FROM Table1 where nategacode=2") rs.MoveFirst While (Not rs.EOF) MyFile = CurrentProject.Path & "\savefrom\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) DstFile = CurrentProject.Path & "\saveto\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Kill MyFile rs.Edit rs.Fields("imagepath").Value = DstFile rs.Update rs.MoveNext Wend rs.Close Set rs = Nothing MsgBox "تم نقل الصور بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" DoCmd.Requery فصل صور الطلاب.zip

وعليكم السلام ورحمة الله وبركاته قم بتحميل تطبيق google drive https://www.google.com/drive/download/ قم بتحديد مجلد google drive في المكان الذي تريده قم بعمل كود لانشاء نسخة احتياطية في حدث الاغلاق If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", _ vbQuestion + vbYesNo, _ "نسخة احتياطية") = vbYes Then On Error Resume Next Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB Dim fs, cf, strFolder strFolder = CurrentProject.Path & "\Backup" Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then Set cf = fs.CreateFolder(strFolder) End If OldFile = CurrentDb.Name ' السطر التالي قم بتغييره الى مسار الحفظ الجديد StrNew = CurrentProject.Path & "\Backup" DBwithEXT = Dir(OldFile) DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6) If [BKUP] = True Then NewFile = StrNew & "\" & DBwithoutEXT & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & Right(DBwithEXT, 6) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 Exit Sub End If End If انتبه لتغيير المسار تحياتي تحياتي

بعد إذن حبيبي @Ali Mohamed Ali هذه مشكلة معروفة مع دالة vlookup أنها لا تجلب نتائج من عمود يسبق عمود البحث ولكن الحل معها استعمال هذا الشرط لعكس اتجاه البحث فتصبح المعادلة =VLOOKUP(J7,IF({1,0},$C$7:$C$11, $B$7:$B$11),2,FALSE) أو =VLOOKUP(J7,IF({0,1},$B$7:$B$11,$C$7:$C$11),2,FALSE) بالتوفيق

هذا بالطبع امر طبيعى ومنطقى لأنك تبدأ بعمود العاصمة وليس الدولة فى قاعدة البيانات وهذا اتجاه البحث بالعاصمة أما اذا أردت البحث بالدولة فعليك بإستخدام هذه المعادلة ... فلا يمكن استخدام معادلتك نهائياً عند البحث بالدولة وشكراً =INDEX($B$7:$B$11,MATCH($J7,$C$7:$C$11,0)) test1.xlsx

استخدم هذا الكود .... Option Compare Database Dim dblStart As Double Dim dblEnd As Double Dim dblTime As Double Private Sub txtTest_Change() If Len(txtTest.Text) <= 1 Then dblStart = Timer Else dblEnd = Timer dblTime = Round(dblEnd - dblStart, 2) If dblTime > 0.2 Then txtTest = "" MsgBox " عفوا ... لايمكن الإدخال إلا عن طريق قارئ الباركود" End If End If End Sub

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

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

جرب هذا حساب عمولة المندوب.xlsx

جزاك الله خيرا

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

مرحبا بك إبراهيم أولا : قائمة بأسماء الشيتات ثانيا : الخلية التى بها الأسماء نعمل لها داتا فاليديشن بحيث تظهر بها القائمة السابقة ثالثا : بالكود الموجود فى حدث التغيير بالصفحة ننتقل إلى اسم الشيت الموجود بالخلية و هذا هو الكود الذى وضعته بكل الأوراق كى يمكنك العودة Private Sub worksheet_change(ByVal target As Excel.Range) Dim ws As Worksheet For Each ws In Worksheets If ws.Name = Sheets("1").Range("b1").Value Then ws.Visible = True ws.Select End If Next ws End Sub