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

وعليكم السلام ورحمة الله وبركاته ,, في النموذج ، وبعد ان تحدد مربع النص الذي يتم عرض الروابط فيه ، من تبويب Format - تنسيق ، فعل الخيار التالي :- لتحصل على النتيجة :- إضافة الى ما سبق ، تستطيع إضافة الكود التالي لمربع النص في حدث عند النقر :- Dim link As String link = Me.Emails.Value If link <> "" Then Application.FollowHyperlink link End If حيث في مثال ، اسم مربع النص هنا = Emails

من نفس المرفق أخي عبداللطيف :-

وعليكم السلام ورحمة الله وبركاته .. الأمر يسير أخي @عبد اللطيف سلوم ان شاء الله انشئ نموذج وفي زر التسجيل استخدم الكود التالي Private Sub Command7_Click() Dim rs As DAO.Recordset Dim sql As String sql = "SELECT 1 FROM Tbl_Party WHERE DATE_PARTY = #" & Me.DATE_PARTY & "# " & _ "AND ((#" & Me.TIME_PARTY_START & "# BETWEEN TIME_PARTY_START AND TIME_PARTY_END) " & _ "OR (#" & Me.TIME_PARTY_END & "# BETWEEN TIME_PARTY_START AND TIME_PARTY_END) " & _ "OR (TIME_PARTY_START BETWEEN #" & Me.TIME_PARTY_START & "# AND #" & Me.TIME_PARTY_END & "#))" Set rs = CurrentDb.OpenRecordset(sql, dbOpenSnapshot) If Not rs.EOF Then MsgBox "يوجد حجز مسبق لهذه الفترة!", vbExclamation, "تنبيه" Else CurrentDb.Execute "INSERT INTO Tbl_Party (DATE_PARTY, TIME_PARTY_START, TIME_PARTY_END) " & _ "VALUES (#" & Me.DATE_PARTY & "#, #" & Me.TIME_PARTY_START & "#, #" & Me.TIME_PARTY_END & "#)", dbFailOnError MsgBox "تم حفظ الحجز بنجاح!", vbInformation, "تأكيد" End If rs.Close: Set rs = Nothing End Sub WEEDING HALLS.accdb

الحمدلله افتح الملفين هذا البرنامج + البرنامج الخارجي ادخل في البرنامج الخارجي ثم عرض ثم وحدات الماكرو ستجد ماكرو (هو الماكرو الوحيد) اسمه aboeed اضغط تشغيل اختر مسح البيانات وكل شيء سيكون أمامك في ورقة أرشفة بطاقة العمل في انتظار ملاحظاتك تفضل برنامج بطاقة عمل 2025.xlsb

👍 Format(DateAdd("d", -1, Me.DATE_PARTY)

بعد بحثي عن هذا الملف من مشروع إدارة صالة أفراح في العاصمة عمان ، جرب هذا التعديل :- Afra7.accdb

شكرا لحضرتك استاذ خليفة.

خلي قيمة افتراضية لمربع نص PAID صفر أو وضع إسم تلك المربع بين دالة NZ(PAID,0) CurrentDb.Execute "INSERT INTO Tbl_Party (HUSBAND_NAME, DATE_PARTY, PARTY_ID, COST_AMOUNT, PAID) " & _ "VALUES ('" & Me.HUSBAND_NAME & "', #" & Format(Me.DATE_PARTY, "dd/mm/yyyy") & "#, " & _ Me.PARTY_ID & ", " & Me.COST_AMOUNT & ", " & Nz(Me.PAID, 0) & ")", dbFailOnError

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

اخي الكريم الموديول ليس له علاقة بهذا الملف .

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

يعمل عندي وبشكل جيد . عموماً سأعدل تنسيق التاريخ Access يحتاج إلى التنسيق الأمريكي (yyyy-mm-dd) عند التعامل مع SQL. استخدام dd/mm/yyyy قد يؤدي إلى أخطاء عند إدخال التواريخ. اليكم المرفق بعد تعديل تنسيق التاريخ . WEEDING HALLS (112).rar

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

جزاكم الله خير واعتذر ان اتعبناكم بسوء الشرح

تفضل استاذ @Zooro1 المرفق وشرح طريقة ادخال التاريخ والأوقات والسعر . ووافني بالرد . DDTimesTest .rar

تفضل استاذي @عبد اللطيف سلوم محاولتي للتغلب على اعدادات التوقيت عملت جدول خاص لكل توقيت وترقيمه (PARTY_ID) استخدمته مع شرط اسم الحاجز وتاريخ الحجز . ووافني بالرد . WEEDING HALLS (111).rar

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

وعليكم السلام ورحمة الله تعالى وبركاته إدا كنت قد فهمت طلبك بشكل صحيح فربما هدا سيوفي بالغرض Option Explicit Dim WS As Worksheet Dim OnRng As Variant Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set WS = Sheets("Sheet1") If Not Intersect([A2:A11], Target) Is Nothing And Target.Count = 1 Then OnRng = WS.Range("C2:C" & WS.Cells(WS.Rows.Count, "C").End(xlUp).Row).value Me.ComboBox1.List = Application.Transpose(OnRng) Me.ComboBox1.Height = Target.Height + 3 Me.ComboBox1.Width = Target.Width Me.ComboBox1.Top = Target.Top Me.ComboBox1.Left = Target.Left Me.ComboBox1.value = Target.value Me.ComboBox1.Visible = True Me.ComboBox1.Activate Else Me.ComboBox1.Visible = False End If End Sub Private Sub ComboBox1_Change() If Me.ComboBox1.value <> "" Then Dim d1 As Object Set d1 = CreateObject("Scripting.Dictionary") Dim tmp As String tmp = UCase(Me.ComboBox1.value) & "*" Dim i As Long For i = 1 To UBound(OnRng, 1) If UCase(OnRng(i, 1)) Like tmp Then d1(OnRng(i, 1)) = "" Next i Me.ComboBox1.List = d1.Keys Me.ComboBox1.DropDown End If ActiveCell.value = Me.ComboBox1.value End Sub Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.ComboBox1.List = Application.Transpose(OnRng) Me.ComboBox1.Activate Me.ComboBox1.DropDown End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell.Offset(1).Select End If End Sub قائمة منسدلة مع البحث والاكمال التلقائي.xlsb

لا تقلق سيستمر مع اضافة بيانات جرب التعديل الأعلى

عندي انا يعمل 100% في شيت الاول لا تعمل اي شيء البرنامج يعمل تسطير من تلقاء نفسه مع بدء كتابة في صف جديد عملت لك فلاتر اذا حبيت تصدير بين تاريخين ، اكتب تاريخين " من الى" ثم اضغط على زر فلتر ما فهمت قصك بضبط ، حاليا كيو آركود موجو في عمود M و نص كيوآركود من عمود I في نفس صف، و يعمل كماهو على كل حال انت جرب المرفق و شوف نتيجة أنشطة 2025 (A).xlsb

تفضل استاذ @عالم الهندسة المرفق بعد التعديل .ووافني بالرد . حجز (4).rar

أتمنى أن أكون قد فهمت الفكرة بشكل صحيح .. جرب هذا الكود في الزر Private Sub أمر7_Click() Dim strCriteriaHall1 As String, strCriteriaHall2 As String Dim HallName1 As String, HallName2 As String Dim checkInDate As String Dim existingClient1 As Variant, existingClient2 As Variant Dim existingCheckIn1 As Variant, existingCheckIn2 As Variant Dim existingCheckOut1 As Variant, existingCheckOut2 As Variant HallName1 = Replace(Me.m3.Caption, "'", "''") HallName2 = Replace(Me.m5.Caption, "'", "''") checkInDate = "#" & Format(Me.m4, "mm/dd/yyyy") & "#" strCriteriaHall1 = "HallName='" & HallName1 & "' AND Check_in <= " & checkInDate & " AND Check_out >= " & checkInDate strCriteriaHall2 = "HallName='" & HallName2 & "' AND Check_in <= " & checkInDate & " AND Check_out >= " & checkInDate existingClient1 = DLookup("Client_Name", "tbl_HallReservation", strCriteriaHall1) existingCheckIn1 = DLookup("Check_in", "tbl_HallReservation", strCriteriaHall1) existingCheckOut1 = DLookup("Check_out", "tbl_HallReservation", strCriteriaHall1) existingClient2 = DLookup("Client_Name", "tbl_HallReservation", strCriteriaHall2) existingCheckIn2 = DLookup("Check_in", "tbl_HallReservation", strCriteriaHall2) existingCheckOut2 = DLookup("Check_out", "tbl_HallReservation", strCriteriaHall2) If Not IsNull(existingClient1) Then Me.aa.Value = "القاعة غير متاحة" Me.bb.Value = "الاسم: " & existingClient1 & vbNewLine & _ "القاعة: " & HallName1 & vbNewLine & _ "تاريخ الدخول: " & Format(existingCheckIn1, "dd/mm/yyyy") & vbNewLine & _ "تاريخ الخروج: " & Format(existingCheckOut1, "dd/mm/yyyy") Else Me.aa.Value = "متاحة" Me.bb.Value = "لا توجد حجوزات سابقة لهذه القاعة" End If If Not IsNull(existingClient2) Then Me.DD.Value = "القاعة غير متاحة" Me.ff.Value = "الاسم: " & existingClient2 & vbNewLine & _ "القاعة: " & HallName2 & vbNewLine & _ "تاريخ الدخول: " & Format(existingCheckIn2, "dd/mm/yyyy") & vbNewLine & _ "تاريخ الخروج: " & Format(existingCheckOut2, "dd/mm/yyyy") Else Me.DD.Value = "متاحة" Me.ff.Value = "لا توجد حجوزات سابقة لهذه القاعة" End If End Sub حجز (2).accdb

تفضل جرب هدا التعديل Option Explicit Sub test() Dim wbDest As Workbook, wbData As Workbook Dim WS As Worksheet, CrWS As Worksheet Dim Irow&, nRow&, xPath$, xFile$, fname As Variant Dim i, j, k As Integer, ShArr As Variant, OnRng, tmps As Range Dim WSIndex As Integer SetApp False xPath = ThisWorkbook.Path fname = Array("رصيد التوكيلات1.xlsx", "رصيد التوكيلات_كفرالشيخ.xlsx", "رصيد التوكيلات_البحيرة.xlsx", _ "رصيد التوكيلات_طنطا.xlsx", "رصيد التوكيلات_المنصورة.xlsx", "رصيد التوكيلات_دكرنس.xlsx", _ "رصيد التوكيلات_دمياط.xlsx", "رصيد التوكيلات_المنوفية.xlsx", "رصيد التوكيلات_الشرقية.xlsx", _ "رصيد التوكيلات_الاسماعيلية.xlsx", "رصيد التوكيلات_بور سعيد.xlsx", "رصيد التوكيلات_السويس.xlsx", _ "رصيد التوكيلات_المقطم.xlsx", "رصيد التوكيلات_مؤسسة الزكاة.xlsx", "رصيد التوكيلات_الجيزة.xlsx", _ "رصيد التوكيلات_القليوبية.xlsx", "رصيد التوكيلات_الفيوم.xlsx", "رصيد التوكيلات_بنى سويف.xlsx", _ "رصيد التوكيلات_المنيا.xlsx", "رصيد التوكيلات_اسيوط.xlsx", "رصيد التوكيلات_سوهاج.xlsx", _ "رصيد التوكيلات_جرجا.xlsx", "رصيد التوكيلات_قنا.xlsx", "رصيد التوكيلات_نجع حمادى.xlsx", _ "رصيد التوكيلات_الغردقة.xlsx", "رصيد التوكيلات_الاقصر.xlsx", "رصيد التوكيلات_اسوان.xlsx", _ "رصيد التوكيلات_ادفو.xlsx") ShArr = Array("الاسكندرية", "كفرالشيخ", "البحيرة", "طنطا", "المنصورة", "دكرنس", _ "دمياط", "المنوفية", "الشرقية", "الاسماعيلية", "بور سعيد", "السويس", _ "المقطم", "مؤسسة الزكاة", "الجيزة", "القليوبية", "الفيوم", "بنى سويف", _ "المنيا", "اسيوط", "سوهاج", "جرجا", "قنا", "نجع حمادى", "الاقصر", "اسوان", "ادفو") Set wbData = ThisWorkbook On Error Resume Next Set wbDest = Workbooks.Open(xPath & "\" & fname(0), ReadOnly:=True) If wbDest Is Nothing Then MsgBox "تعذر العثور على الملف " & fname(0), vbCritical SetApp True Exit Sub End If On Error GoTo 0 For WSIndex = LBound(fname) To UBound(fname) xFile = xPath & "\" & fname(WSIndex) On Error Resume Next Set wbDest = Workbooks.Open(xFile, ReadOnly:=True) If wbDest Is Nothing Then MsgBox "تعذر العثور على الملف " & fname(WSIndex), vbCritical SetApp True Exit Sub End If On Error GoTo 0 For i = LBound(ShArr) To UBound(ShArr) On Error Resume Next Set CrWS = wbData.Sheets(ShArr(i)) On Error GoTo 0 If Not CrWS Is Nothing Then Set WS = Nothing On Error Resume Next Set WS = wbDest.Sheets(ShArr(i)) On Error GoTo 0 If Not WS Is Nothing Then Irow = WS.Cells(WS.Rows.Count, 2).End(xlUp).Row If Irow < 4 Then GoTo SkipSheet End If For j = 6 To 19 Set tmps = CrWS.Cells(3, j) For k = 6 To 19 Set OnRng = WS.Cells(3, k) If OnRng.Value = tmps.Value And Not IsEmpty(OnRng.Value) Then For nRow = 4 To 71 If Not IsEmpty(WS.Cells(nRow, k).Value) Then CrWS.Cells(nRow, j).Value = WS.Cells(nRow, k).Value End If Next nRow Exit For End If Next k Next j For nRow = 4 To 71 If Not IsEmpty(WS.Cells(nRow, 2).Value) Then CrWS.Cells(nRow, 2).Value = WS.Cells(nRow, 2).Value End If Next nRow End If End If SkipSheet: Next i SkipFile: wbDest.Close False Next WSIndex MsgBox "تم نقل البيانات من جميع الملفات بنجاح", vbInformation SetApp True End Sub Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next Application.ScreenUpdating = enable Application.EnableEvents = enable Application.DisplayAlerts = enable Application.Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End Sub نقل البيانات من مصنفات متعددة.rar

فين الشيت للعمل عليه

وعليكم السلام ورحمة الله وبركاته الموضوع طويل وشائك نوعا ما ولكن رحلة الف ميل تبدأ بخطوة وهذه هي الخطوة (خطوة جامدة) هذا ملف من هذا المنتدى فيه صلاحيات المستخدمين حسين (كلمة مروره 123) هو ال King يستطيع التحكم في ظهور وأخفاء جميع الأوراق في البرنامج وكذالك يتحكم في صلاحيات المستخدمين الباقين بينما حمد (كلمة مروره 11) لا يستطيع التحكم إلا في بعض الأوراق بحسب ما حددها له حسين إذن حسين يستطيع أن يوزع صلاحيات الأوراق وكلمات المرور على المستخدمين ممكن أن نجعل حمد كذلك يتحكم في جميع الأوراق في البرنامج بأن نكتب أمام جمع الأوراق كلمة (نعم) لا أطيل الكلام , التفاصيل داخل البرنامج المرفق تنبيه : كما قلت هذه هي الخطوة الأولى شاشة الدخول مع صلاحيات المستخدمين.xlsb

استفسار1.xlsx