عبدالفتاح في بي اكسيل

لماذا تكرر هذا الموضوع واعتقد ان الاخ محمد اجابك وقمت بالاعجاب يعني قام بحل الموضوع https://www.officena.net/ib/topic/113326-تسمية-الملف-بإسم-الأسبوع-والسنة-تلقائيا-عند-الحفظ/ كان وجب عليك اما الرد بالسلب او الايجاب اذا اردت المساعدة من الاخرين .

رائع شكرا على تفاعلك 😉

@محمد بن صالح اعتقد انك محق بخصوص الخطا جرب هذا سيعمل معك قم بتغيير من ActiveWorkbook.SaveAs Filename:="E:\التقرير لتاريخ" & "\العمل " & Format(Date - 1, "DD-MM-YYYY") & ".xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False الى ActiveWorkbook.SaveAs Filename:="E:\التقرير لتاريخ" & "\العمل " & Format(Date - 1, "DD-MM-YYYY") , _ FileFormat:=51, CreateBackup:=False

لا تكثر من اضافة طلب جديد في كل مرة سيجعل الاعضاء غير متحمسين لتقديم المساعدة انظر الى هذه السطر وغير xlsm . الى xlsx . ActiveWorkbook.SaveAs Filename:="E:\العمل\" & "التقرير لتاريخ " & Format(Date - 1, "DD-MM-YYYY") & ".xlsm", FileFormat:= _

مجرد اقتراح ضع هذا السطر Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False بعد Workbooks.Add

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

قم بتطويع هذا الكود مع ما يتناسب مع احتياجاتك Sub export_sheets() Dim Fname As String, ws As Worksheet Application.DisplayAlerts = False ' في هذا السطر ضع اسماء الشيتات المحددة Sheets(Array("sheet1", "sheet2")).Copy For Each ws In ActiveWorkbook.Sheets ws.UsedRange = ws.UsedRange.Value Next ws wb_name = "taqreer" ActiveWorkbook.SaveAs Filename:= _ 'مكان تخزين الملف "C:\Users\alhajaj\Desktop\" & wb_name & " report " & Format(Date, "dd-mm-yy") & ".xlsx", FileFormat:=51 ActiveWorkbook.Close Application.DisplayAlerts = True End Sub

كيف يعقل هذا ؟ 😱 الماكرو قمت بتشغيله وقام بالاخفاء وعند نقر على يمين ورقة البحث لايمكنك النقر على كلمة اظهار قمت بتخميل الملف مرة اخرى ويعمل معي تمام . قم بتحميل الملف مرة اخرى وارني صورة لما تقوله .

تم معالجة الامر بوضع كود في الموديول واذا اردت ارجاع الصيغة ما عليك نسخ نفس الماكرو وتغيير هذه sh.Visible = xlSheetVeryHidden الى sh.Visible = xlSheetvisible hide specific sheets.xlsm

لا اعتقد ان هذه الطريقة سليمة لعملية حساب كهذه لما لا تضع عمودين مدين(مقبوضات) و دائن (مدفوعات) ورصيد افتتاحي قبل اي عملية ان وجدت ومن ثم يتم عمل عملية حسابية في عمود الرصيد بناء على العمودين . مجرد فكرة .

ضع رقم المعرف في الخلية B2 من خلال القائمة في العمود E ملاحظة : يمكنك مسح القائمة فقط لتجربة الكود كيف يعمل. كما يوجد خلايا مدمجة لتجنب اي مشاكل مستقبلية قد تحدث خطا في الكود نتيجة الخلايا المدمجة خصوصا خلية رقم الهوية يجب الغاء دمجها اخيرا نظرا لسرية المعلومات يجب حماية محرر الاكواد برقم سري حتى لا يستطيع احد الولولج من داخله واظهار الاوراق . تحياتي hide specific sheets.xlsm

@طارق حسانين عن تجربة لا gif او png ينفع معهم لا اعتقد ان هناك امكانية لذلك على حد علمي العملية متعلقة ببرمجة اليوزرفورم نفسه ليس له علاقة بالصورة لان اساس الصورة بدون خلفية وعندما تدرجها تصبح الخلفية سوداء

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

اعتقد ان هذا الماكرو يفي بمتطلباتك اكتبي رقم العمود الذي تريدينه ان يقوم بترحيل بياناته Sub parse_data() Dim lr As Long Dim ws As Worksheet Dim vcol, i As Integer Dim icol As Long Dim myarr As Variant Dim title As String Dim titlerow As Integer Application.ScreenUpdating = False vcol = Application.InputBox(Prompt:=" اي العمود الذي تريد فرزه", title:="فلترة عمود", Default:="3", Type:=1) Set ws = ActiveSheet lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row title = "A1" titlerow = ws.Range(title).Cells(1).Row icol = ws.Columns.Count ws.Cells(1, icol) = "Unique" For i = 2 To lr On Error Resume Next If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol) End If Next myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants)) ws.Columns(icol).Clear For i = 2 To UBound(myarr) ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & "" If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & "" Else Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count) End If ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1") 'Sheets(myarr(i) & "").Columns.AutoFit Next ws.AutoFilterMode = False ws.Activate Application.ScreenUpdating = True End Sub

اذا كنت تفضلها بالاكواد بطريقتين 1 - UserForm1.Show 0 2- UserForm1.Show vbModeless

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

قم بضبط الخيار الاول

اضبط الاعداد كما في الصورة قد تكون المشكلة في اعدادات التوثيق

جرب هذا الشيء ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\PC WORLD\Desktop\FILES\" & Range("H10").Value & Format(Date, "mmdd") لا حظ يتم التخزين بناء على قيمة خلية وتاريخ اليوم

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

استغرق مني الكثير من الوقت حتى يعمل نتيجة تعديلات وتصحيحات بناء على متطلباتك اولا الغي جميع الخلايا المدمجة والا الكود لن يعمل بشكل جيد ثانيا قم بتسمية الورقة Summary في الملف الذي سيتم تشغيل الماكرو منه ثالثا ضع جميع الملفات في مجلد واحد ما عدا الملف الذي سيتم من تشغيل الماكرو تجنبا لاي مشاكل رابعا يجب ان يكونوا الملفات من امتداد xlsx خامسا انسخ مسار المجلد الذي به الملفات وقم بوضعه في الكود كما موجود بالضبط (قم بتغيير هذا فقط C:\Users\PC WORLD\Desktop\path) سادسا يجب ان تكون بياناتك كلها في الورقة الاولى لجميع الملفات Public Sub Copy_Values_From_Workbooks() Dim matchWorkbooks As String Dim destSheet As Worksheet, r As Long Dim folderPath As String Dim wbFileName As String Dim fromWorkbook As Workbook matchWorkbooks = "C:\Users\PC WORLD\Desktop\path\*.xlsx" 'Define destination sheet Set destSheet = ActiveWorkbook.Worksheets("Summary") destSheet.Cells.ClearContents r = 0 Application.ScreenUpdating = False folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\")) wbFileName = Dir(matchWorkbooks) While wbFileName <> vbNullString Set fromWorkbook = Workbooks.Open(folderPath & wbFileName) With fromWorkbook.Worksheets(1) destSheet.Range("A3").Value = .Range("A6").Value destSheet.Range("B3").Value = .Range("A4").Value destSheet.Range("C3").Value = .Range("G5").Value destSheet.Range("D3").Value = .Range("G4").Value destSheet.Range("E3").Value = .Range("A19").Value destSheet.Range("B4").Offset(r).Value = .Range("B4").Value destSheet.Range("C4").Offset(r).Value = .Range("H5").Value destSheet.Range("D4").Offset(r).Value = .Range("H4").Value destSheet.Range("E4").Offset(r).Value = .Range("H19").Value r = r + 1 End With fromWorkbook.Close savechanges:=False DoEvents wbFileName = Dir Wend Call test2 Application.ScreenUpdating = True MsgBox "Finished" End Sub Sub test2() With Range("b4", Range("b" & Rows.Count).End(xlUp)).Offset(, -1) .Formula = "=row()-3" .Value = .Value End With End Sub

يعني اضافة القيمة الجديدة على القيمة السابقة وليس استبدال الامرين مختلفين ؟😕

لا يظهر اي خطا عبارة عن ارقام اذا كنت تتحدث عن طريقة عرض التاريخ فغيرها من عام الى تاريخ من التنسيق في نافدة الاوامر

لم اجرب الكود لكن يظهر خطا صحح هذا الشي من .bdf الى .PDF

الكود يعمل اكتب اسم احمد في اي صف باستثناء الاول سيتم وضعه في الاول قبل علي