كل الانشطه

السلام عليكم وفق الله الاستاذ الخبير محمد هشام - على مساعدتي في اعداد الكود وعندي اضافة وحبيت ان تكون في مشاركة جديدة - حسب توجيهات المنتدى الطلب هو اضافة شرط اخر على الكود وهو (الموقع) في شيت اسمه (تقرير منفصل) كما في الملف المرفق تقرير - حسب - الشهر - والشركة.xlsm

الأعمدة عندك ثابثة لغاية عمود Y ممكن تخفيها يدويا عادي أما الصفوف مادا تقصد هل الغاء تنسيق الأعمدة الغير مستخدمة كحدف التسطير او اخفائها نهائيا

تسلم 100 % - الكود شغال وحسب ما مطلوب جزيت خيرا

السلام عليكم هل هذا ملف pdf اللي تريده؟ استعنت ببرنامج اخوي خليفة 🙂 جعفر DD1Testdb2.mdb rpt_ST_Information.pdf

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

بارك الله فيك وشكرا على الشرح . وجمعة مباركة عليك والجميع

السلام عليكم ورحمة الله و بركاته ظهور الفاصلة قبل الرقم مثل '٢/٢ في شريط المعادلة في Excel له دلالة محددة لأن الفاصلة المفردة تستخدم في اكسيل لإجبار الخلية على اعتبار ما بداخلها كنص اكسيل وليس كرقم أو معادلة. في حالتك: عند إدخال ٢/٢ في خلية اكسيل مباشرة فقد يفسره Excel كتاريخ (مثلاً 2 فبراير)، أو ككسر. لإجبار اكسيل على عدم تفسيره وتحويله إلى شيء آخر (تاريخ أو كسر)، يمكن إدخال '٢/٢، فيقوم اكسيل بعرض فقط ٢/٢ في الخلية لكن يظهر '٢/٢ في شريط المعادلة لتوضيح أن هذه القيمة تم إدخالها كنص صريح. ولا تظهر في الطباعة و لا تؤثر في شيء لأنها نص هام: إذا رأيت '٢/٢ في شريط المعادلة: فهذا يعني أن الخلية تحتوي على نص مكتوب يدويًا وليس تاريخًا أو رقمًا أو كسرًا. الفاصلة ' لا تظهر في الخلية، فقط في شريط المعادلة. إذا كتبت 2/2 بدون '، Excel قد يفسرها كـ تاريخ 2 فبراير إذا كانت الخلية بتنسيق التاريخ أو كـ الكسر 1 إذا غيرت التنسيق إلى كسر لذلك تحديد نوع التنسيق مهم لتفسير اكسيل الصحيح.

تسلم ايدك لكن ممكن اخفاء الاعمدة والصفوف الفارغة على قد البيانات فقط

السلام عليكم ورحمة الله وبركاته Sub حذفالكومة() Dim c As Range Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual: Application.EnableEvents = False For Each c In ActiveSheet.UsedRange If VarType(c.Value) = vbString Then Dim txt As String: txt = Trim(c.Value) If Left(txt, 1) = "'" Then txt = Mid(txt, 2) If Right(txt, 1) = "'" Then txt = Left(txt, Len(txt) - 1) If txt <> c.Value Then c.NumberFormat = "@": c.Value = txt End If Next c Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic: Application.EnableEvents = True End Sub ازالة علامة.xlsm

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

وعليكم السلام ورحمة الله تعالى وبركاته Option Explicit Option Compare Text Sub FilterContractorData() Dim CrWS As Worksheet, dest As Worksheet, OnRng, ColArr, a(1 To 4) Const tmp1 = 3, tmp2 = 4, colDate = 1 Set CrWS = Sheets("يومية المقاولين") Set dest = Sheets("تقرير تفصيلى") With Application .ScreenUpdating = False: .Calculation = xlCalculationManual OnRng = CrWS.Range("B8:Y" & CrWS.Cells(CrWS.Rows.Count, "B").End(xlUp).Row).Value a(1) = dest.[D3].Value: a(2) = dest.[E3].Value a(3) = dest.[C6].Value: a(4) = dest.[D6].Value ColArr = FiltreTbl(OnRng, a, tmp1, tmp2, colDate, _ Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24)) If Not IsEmpty(ColArr) Then Dim Lr As Long: Lr = dest.Rows.Count dest.Range("A11:T" & Lr).ClearContents dest.Range("B11").Resize(UBound(ColArr), UBound(ColArr, 2)).Value = ColArr With dest.Range("A11:A" & dest.Cells(dest.Rows.Count, "B").End(xlUp).Row) .Value = Evaluate("ROW(" & .Address & ")-10") End With Else MsgBox "لا توجد بيانات تطابق الشروط المحددة", vbExclamation End If .ScreenUpdating = True: .Calculation = xlCalculationAutomatic End With End Sub Function FiltreTbl(OnRng, a, tmp1, tmp2, colDate, Optional f) Dim cnt(), temp(), b(), n&, j&, i&, k&, r&, vDate n = UBound(OnRng, 2) If IsMissing(f) Then ReDim cnt(0 To n - 1): For k = 0 To n - 1: cnt(k) = k + 1: Next k Else: cnt = f End If j = UBound(cnt): ReDim temp(1 To UBound(OnRng), 1 To j + 1) For i = LBound(OnRng) To UBound(OnRng) vDate = OnRng(i, colDate) If IsDate(vDate) And (a(1) = "" Or OnRng(i, tmp1) = a(1)) And (a(2) = "" Or OnRng(i, tmp2) = a(2)) _ And (vDate >= a(3) And vDate <= a(4)) Then r = r + 1: For k = 0 To j: temp(r, k + 1) = OnRng(i, cnt(k)): Next k End If Next i If r > 0 Then ReDim b(1 To r, 1 To j + 1) For i = 1 To r: For k = 1 To j + 1: b(i, k) = temp(i, k): Next k: Next i FiltreTbl = b Else: FiltreTbl = Empty End If End Function عمالة نظام جديد.xlsm

تفضل أخي Sub test() Dim dest As Worksheet, WS As Worksheet Dim m As String, a As Variant, k As Variant, f As Variant Dim d As Object: Set d = CreateObject("Scripting.Dictionary") Dim ShArr As Variant: ShArr = Array("aaa", "bbb") Dim i As Long, lr As Long, r As Long: r = 2 With Application .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual On Error Resume Next Set dest = Sheets("التقرير") If dest Is Nothing Then Set dest = Sheets.Add: dest.Name = "التقرير" Else dest.Range("A:F").ClearContents On Error GoTo 0 dest.Range("A1").Resize(1, 6).Value _ = Array("الشهر", "اسم الشركة", "عدد النقلات", "مجموع المبلغ للسائق", "مجموع مبلغ العقد", "مجموع الكمية (طن)") For Each WS In Sheets(ShArr) If WS.AutoFilterMode Then WS.AutoFilterMode = False lr = WS.Cells(WS.Rows.Count, "M").End(xlUp).Row For i = 2 To lr If Trim(WS.Cells(i, "M").Text) <> "" And Trim(WS.Cells(i, "L").Text) <> "" Then m = Trim(WS.Cells(i, "M").Text) & "|" & Trim(WS.Cells(i, "L").Text) If Not d.exists(m) Then d(m) = Array(0, 0, 0, 0) d(m) = Array(d(m)(0) + 1, d(m)(1) + tmp(WS.Cells(i, "S").Value), _ d(m)(2) + tmp(WS.Cells(i, "U").Value), d(m)(3) + tmp(WS.Cells(i, "F").Value)) End If Next i Next WS For Each k In d.Keys f = Split(k, "|") a = d(k) dest.Cells(r, 1).Resize(1, 6).Value = Array(f(0), f(1), a(0), a(1), a(2), a(3)) r = r + 1 Next k .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic End With MsgBox "تم إعداد التقرير بنجاح", vbInformation End Sub Private Function tmp(x As Variant) As Double tmp = IIf(IsNumeric(x), x, 0) End Function الشهر والشركة.xlsm

اخي ريان نحاول المساعدة ولكنك لم تكلف نفسك بادراج ملف PDF الموجود لديك لنرى التصميم لديك ولا قاعدة بياناتك ( انت ادرجت لنا مرة اخرى قاعدة بيانات الاستاذ @kkhalifa1960 لنقل بيانات من الاكسس الى PDF : اولا يجب ان يكون لديك برنامج برنامج Adobe Acrobat Pro (وليس Adobe Reader فقط) او برنامج PDFtk ثانيا ملف PDF يجب ان يكون استمارة فردية اي لعرض بيانات فردية وليس نموذج مستمر كما ارفقت انت في مثال اخونا خليفة ثالثا تفعيل المرجع Adobe Acrobat xx.x Type Library (xx = رقم الإصدار مثل 10.0 أو 11.0) رابعا يجب أن يحتوي ملف الـ PDF على الحقول المسماة مثلا : وهذه يم اضافتها عن طريق البرامج المذكورة في اولا "Text1" "Dropdown2" "todaysDate" خامسا استخدام هذه الشيفرة اذا كان البرنامج المستخدم PDFtk ::::::::::::::::::::::::: Sub FillPDF() Dim tempFDF As String Dim pdfInput As String Dim pdfOutput As String Dim shellCmd As String Dim fso As Object Dim fdfContent As String Dim pdftkPath As String Dim appPath As String ' تحديد مسار البرنامج الحالي (نفس مجلد قاعدة البيانات أو ملف الإكسل) appPath = Application.CurrentProject.Path ' Access ' إذا كنت تستخدم Excel بدلاً من Access، استبدل بالسطر التالي: ' appPath = ThisWorkbook.Path ' تحديد مسار الملفات pdfInput = appPath & "\template.pdf" ' اسم ملف PDF بجانب الملف pdfOutput = appPath & "\output_filled.pdf" ' ملف الإخراج بجانب الملف tempFDF = appPath & "\temp_data.fdf" ' ملف FDF مؤقت ' مسار برنامج PDFtk pdftkPath = """C:\Program Files (x86)\PDFtk Server\bin\pdftk.exe""" ' تحضير محتوى FDF fdfContent = "%FDF-1.2" & vbCrLf fdfContent = fdfContent & "1 0 obj<</FDF<< /Fields[" & _ "<< /T (Text1) /V (" & Me.Text0.Value & ") >>" & _ "<< /T (Dropdown2) /V (" & Me.Text2.Value & ") >>" & _ "<< /T (todaysDate) /V (" & Me.Text4.Value & ") >>" & _ "] >> >>endobj" & vbCrLf fdfContent = fdfContent & "trailer<</Root 1 0 R>>" & vbCrLf fdfContent = fdfContent & "%%EOF" ' إنشاء ملف FDF Set fso = CreateObject("Scripting.FileSystemObject") With fso.CreateTextFile(tempFDF, True) .Write fdfContent .Close End With ' تنفيذ الأمر باستخدام PDFtk shellCmd = pdftkPath & " """ & pdfInput & """ fill_form """ & tempFDF & """ output """ & pdfOutput & """ flatten" Shell shellCmd, vbHide MsgBox "تم إنشاء الملف: " & pdfOutput End Sub سادسا استخدام هذه الشيفرة اذا كان البرنامج المستخدم Adobe Acrobat Pro ::::::::::::::::::::::::: Dim AcroApp As Acrobat.CAcroApp Dim theForm As Acrobat.CAcroPDDoc Dim jso As Object Dim path As String Dim field As Object Dim Text1, Dropdown2, todaysDate As String Dim Text0, Text2, Text4 As String Set AcroApp = CreateObject("AcroExch.App") Set theForm = CreateObject("AcroExch.PDDoc") theForm.Open (Me.Label16.Caption) Set jso = theForm.GetJSObject 'write the values to corresponding pdf fields jso.getfield("Text1").Value = Me.Text0.Value jso.getfield("Dropdown2").Value = Me.Text2.Value jso.getfield("todaysDate").Value = Me.Text4.Value theForm.Save PDSaveIncremental, Me.Label16.Caption theForm.Close AcroApp.Exit Set AcroApp = Nothing Set theForm = Nothing سابعا ::: انا دوري انتهى هنا بارك الله فيك

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

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

أخي الفاضل بعد سلام الله عليكم ورحمة الله وبركاته فيه ملحوظة هامة أثناء فتح تقرير الشهادات لاحظت اللون لا يدل علي التقييم انظر اخي الفاضل مثلا اللغة العربية في الشهادة الأولي ( اللون : أزرق ) ولكن ( التقييم : يلبي التوقعات ) مع أن المفروض ( يفوق التوقعات )

شكرا جزيلا أخي الفاضل وبارك الله فيك

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

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

نرجوا من الإخوة مساعدتي

الموضوع بالإنجليزية ملف PDF يكون صفحته فارعة يوجد به معلومات اساسية مثل الرقم اللقب الاسم تاريخ الميلاد وبعد البحث عن الموظف يمتلئ صفحة PDF مثلا الموظف الرقم 1001 اللقب ALI الاسم Hassan تاريخ الميلاد 01/01/1999 PDF Report.rar

اي علاقة الديانة لم تدرج في الاستعلامات من الأساس تفضل التقرير شامل تحليلي النصفين لجميع الصفوف .. Data13.rar

جزاك الله خير - تمام 100 % ممكن اضافة فقرة اخرى - في عمود l اسم الشركة - ليكون التقرير حسب الشهر واسم الشركة الشهر والشركة.xlsm

الموضوع بالإنجليزية

عند اختيار مكان الشغل او اسم المقاول بين التاريخين يتم استدعاء البيانات من شيت يومية المقاولين عمالة نظام جديد.xlsm