كل الانشطه

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

السلام عليكم ورحمة الله وبركاته 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

تفضل ازالة علامة.xlsx

المطلوب ازاله الكومة من خلف الرقم او امام الرقم ازالة علامة.xlsx

ابخصوص الاستعلام الاول لا تاخذ به انا نسيت ان ازيله

السلام عليكم ورحمة الله وبركاته استاذنا العزيز kkhalifa1960 في هذا المثال تم تحديد مكان تصدير التقرير في مكان وجود قاعدة البيانات والذي هو CurrentProject.Path طيب انا حاولت انه عند تصدير التقرير , المستخدم يحدد مكان تصدير التقرير عن طريق مربع الحوار application.fileDialog ولكن لم استطيع تنفيذ هذا الامر ! هل من الممكن المساعدة في هذا الموضوع ؟ MergMic.rar

شكرا على المجهود لكن التقصير مني لم اوصلكلك الفكرة بشكل واضح ان واضع شرط لازم يكون الجمع بنفس nemeroimp وبفس السنة anneeimpo ارفق لك ملف اكسيل يوضح الموضع بشكل جيد oool1.xlsx

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

تفضل استاذ @alloui79 المرفق بعد التعديل بطلبك حسب مافهمت بالاستعلام 2 . ووافني بالرد . Database9-2.rar