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

في اعلا النموذج لديك ضع دالة Sleep لانها غير موجودة لديك #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If

تفضل ورقة دخول للصلاحيات ورقة KEYS فيها أسماء المستخدمي وكلمات مرورهم وصلاحية كل مستخدم أي : ما هي الأوراق التي تريد أخفاءها عن المستخدم وما هي الاوراق التي تريد إظهارها تلاحظ أن أول مستخدم هو aaa وكلمة مروره هي 111 (هذا افتراضيا وتستطيع تغييرها ) تلاحظ أن المستخدم aaa هو الوحيد الذي له الحق في إظهار KEYS والتعديل عليها لأن صفحة KEYS له قيمتها = 1 وبقية المستخدمين = 0 أذن aaa هو المتحكم في النظام وبقية المستخدمي لا يستطيعون تغيير صلاحياتهم تلاحظ أيضا أن المستخدم qaq , وكلمة مروره 55 لا يوجد له رقم في العمود K وهذا يعني أنه غير مصرح له بالدخول الخلاصة : المستخد aaa يستطيع : ـ منع أي مستخدم من الدخول حتى لو كان يملك كلمة المرور الصحيحة ـ التحكم في إظهار وأخفاء الشيتات لكل مستخدم عن طريق القيمتين 1 (أظهار) , 0 (أخفاء) إلى هنا أتوقف وإن ظهرت أي مشكلة فعليك فتح موضوع جديد وإرسال طلبك في أمان الله جرب المرفق , Horaire3.xlsb

شكراً لك للإفادة بالنتيجة .. والحمد لله على نجاح المهمة ..

كل شيء ممكن في الاكسل ولكن المشاكل تحل خطوة بخطوة جرب الملف Horaire2.xlsb

شكرا ايها الخبير المبدع جزاك الله بكل الخير وزادك من علمه

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

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

تفضل استاذ @jo_2010 كود الزر بعد التعديل بطلبك .ووافني بالرد . Private Sub أمر1595_Click() Dim TaskDialog As Y_CTaskDialog Set TaskDialog = New Y_CTaskDialog Dim sSubReport As String sSubReport = Screen.ActiveControl.Caption ' مسار التصدير Dim sBasePath As String Dim sFolder As String Dim sPDF As String sBasePath = CurrentProject.Path sFolder = sBasePath & "\MyReports" ' إنشاء المجلد إن لم يكن موجودًا If Dir(sFolder, vbDirectory) = "" Then MkDir sFolder End If With TaskDialog .Init .ParenthWnd = Me.hwnd .Flags = TDF_RTL_LAYOUT Or TDF_USE_COMMAND_LINKS _ Or TDF_USE_IMAGERES_ICONID_BUTTON .AddCustomButton 101, _ " طبـاعـة كـل التقـارير بتاريخ " & " / " & DDate & vbLf & _ " عدد التقارير " & URn & " تقرير ", 5380 .AddCustomButton 102, _ " طبـاعـة تقــريــــر واحــــد " & vbLf & _ " باســــم / " & PNAME & " ", 5351 .AddCustomButton 103, _ " تــراجــــــع عـن الطبــاعـة ", 5315 .SetWindowsButtonIconSize 32 .MainInstruction = "جمعية حماية البيئة من التلوث" .Content = "معمـل الام والطفــل" .IconMain = 76 .Title = "طباعـــة" .Width = 250 .ShowDialog Select Case .ResultMain ' ===== الحالة 101 ===== Case 101 Me.Refresh ' مسار واسم ملف PDF sPDF = sFolder & "\AllReports_" & _ Format(Me.DDate, "yyyy-mm-dd") & ".pdf" ' فتح التقرير في وضع مخفي DoCmd.OpenReport "Y_N_Report", acViewPreview, , _ "ddate = #" & Format(Me.DDate, "yyyy-mm-dd") & "# AND NOT IsNull(colour)", _ acHidden, sSubReport ' تصدير التقرير إلى PDF DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False ' إغلاق التقرير DoCmd.Close acReport, "Y_N_Report" ' فتح ملف الـ PDF بعد التصدير Application.FollowHyperlink sPDF ' ===== الحالة 102 ===== Case 102 Me.Refresh Dim PatientName As String Dim FileDate As String Dim RLM As String Dim LRM As String RLM = ChrW(&H200F) ' Right-To-Left Mark LRM = ChrW(&H200E) ' Left-To-Right Mark ' اسم المريض PatientName = Me.PNAME ' تنظيف الرموز غير المسموحة PatientName = Replace(PatientName, "/", "-") PatientName = Replace(PatientName, "\", "-") PatientName = Replace(PatientName, ":", "-") ' التاريخ FileDate = Format(Date, "dd-MM-yyyy") ' اسم الملف (اتجاه مضبوط 100%) sPDF = sFolder & "\" & _ RLM & PatientName & RLM & "_" & LRM & FileDate & ".pdf" ' فتح التقرير بشكل مخفي DoCmd.OpenReport "Y_N_Report", acViewPreview, , _ "[PCode]=" & Me.PCode, acHidden, sSubReport ' تصدير PDF DoCmd.OutputTo acOutputReport, "Y_N_Report", acFormatPDF, sPDF, False ' إغلاق التقرير DoCmd.Close acReport, "Y_N_Report" ' فتح ملف الـ PDF Application.FollowHyperlink sPDF Case 103 Exit Sub End Select End With Set TaskDialog = Nothing End Sub

طيب استخرج المجلد بجوار القاعدة ثم استخدم هذا الكود Sub ExportReports_To_OnePDF_PDFtk() Dim arrReports As Variant Dim i As Integer Dim strTempFolder As String Dim strFinalPDF As String Dim strPDFtk As String Dim strCmd As String strPDFtk = CurrentProject.Path & "\PdftkBuilderPortable\pdftk.exe" strTempFolder = CurrentProject.Path & "\TempPDF\" strFinalPDF = CurrentProject.Path & "\AllReports.pdf" arrReports = Array("rpt1", "rpt2", "rpt3") If Dir(strTempFolder, vbDirectory) = "" Then MkDir strTempFolder End If If Dir(strTempFolder & "*.pdf") <> "" Then Kill strTempFolder & "*.pdf" End If For i = LBound(arrReports) To UBound(arrReports) DoCmd.OutputTo acOutputReport, arrReports(i), acFormatPDF, _ strTempFolder & (i + 1) & "_" & arrReports(i) & ".pdf", False Next i strCmd = """" & strPDFtk & """ " & _ """" & strTempFolder & "*.pdf"" cat output " & _ """" & strFinalPDF & """" Shell strCmd, vbHide MsgBox "تم إنشاء ملف PDF واحد بنجاح ?" & vbCrLf & strFinalPDF, vbInformation Kill strTempFolder & "*.pdf" End Sub PdftkBuilderPortable.rar

اليك الملف وبه الكود اضغط غلى الزر ليعمل الكود example.xlsb

العفو أخي الكريم .. يسعدنا أن تستفيد من المعلومة بشكل أكبر من الحلول الجاهزة التي ستتعرض لها مستقبلاً , جميع الجهود مشكورة لمن يحاول المساعدة . ولكن بنظري أن تصحيح المسار أفضل من السير في تعرج